home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.2 / Three-D-Graphics.st < prev    next >
Text File  |  1993-07-24  |  122KB  |  4,403 lines
  1. "    NAME        Three-D-Graphics
  2.     AUTHOR        tph@cs.man.ac.uk
  3.     FUNCTION 3d pic editor 
  4.     ST-VERSIONS    2.2
  5.     PREREQUISITES    RepeatSwitchController 
  6.     CONFLICTS    
  7.     DISTRIBUTION      world
  8.     VERSION        1.1
  9.     DATE    22 Jan 1989
  10. SUMMARY    Three-D-Graphics
  11.     contains the first release of Trevor's Three-D
  12.    object editor.  This is known to work only with VI2.2 images; some
  13.    work would be required to get it up function with earlier images.
  14.    To get it going, try: ""ThreeDView openOn: Cone default"".
  15.    You should file in the RepeatSwitchController.st goodie before this
  16.    one.
  17.    There are a number of known bugs with this version; in particular,
  18.    attempting to manipulate deeply structured objects sometimes causes
  19.    the mouse to `lose' the appropriate vertex.  Also, the `fill'
  20.    option doesn't always work correctly.  The View/Controller
  21.    structure in extremely convoluted, and no attempt has been made to
  22.    document it (yet!).
  23. "!
  24. 'From Smalltalk-80, Version 2.2 of July 4, 1987 on 1 November 1987 at 8:40:19 pm'!
  25.  
  26.  
  27.  
  28. !Dictionary methodsFor: 'accessing'!
  29.  
  30. at: key addIfAbsent: aBlock
  31.     "returns the value at the key.  If key is absent, evaluates the block
  32.      and adds the result to self"
  33.     | obj |
  34.     ^self at: key 
  35.           ifAbsent: [obj _ aBlock value.
  36.                      self add: (Association key: key value: obj).
  37.                      obj]! !'From Smalltalk-80, Version 2.2 of July 4, 1987 on 1 November 1987 at 8:51:41 pm'!
  38.  
  39.  
  40.  
  41. !Form class methodsFor: 'instance creation'!
  42.  
  43. fromRectangle: aRectangle
  44.     | form |
  45.     form _ self extent: aRectangle extent.
  46.     form offset: aRectangle origin.
  47.     ^form! !'From Smalltalk-80, Version 2.2 of July 4, 1987 on 1 November 1987 at 8:46:50 pm'!
  48.  
  49.  
  50.  
  51. !Number methodsFor: 'testing'!
  52.  
  53. signPositive
  54.     "Answer 1 if the receiver is greater than 0 else -1."
  55.  
  56.     self >= 0 ifTrue: [^1] ifFalse: [^-1]! !'From Smalltalk-80, Version 2.2 of July 4, 1987 on 1 November 1987 at 8:13:13 pm'!
  57.  
  58.  
  59.  
  60. !Point methodsFor: 'converting'!
  61.  
  62. asThreeDPoint
  63.     "Answer with a ThreeDPoint with the same x and y coordinates
  64.      as the receiver, and a z coordinate of zero."
  65.  
  66.     ^ThreeDPoint x: self x y: self y z: 0.0! !
  67.  
  68. 'From Smalltalk-80, Version 2.2 of July 4, 1987 on 1 November 1987 at 8:13:31 pm'!
  69.  
  70.  
  71.  
  72. !Number methodsFor: 'converting'!
  73.  
  74. asThreeDPoint
  75.     "Answer a new ThreeDPoint with the receiver as all coordinates;  
  76.      often used to supply the same value in three dimensions, as with 
  77.      symmetrical gridding or scaling."
  78.  
  79.     ^ThreeDPoint
  80.         x: self
  81.         y: self
  82.         z: self! !
  83.  
  84. Object subclass: #ThreeDPoint
  85.     instanceVariableNames: 'x y z '
  86.     classVariableNames: ''
  87.     poolDictionaries: ''
  88.     category: 'Three-D-Graphics'!
  89. ThreeDPoint comment:
  90. 'I represent a point in 3-D space.  I have three instance variables
  91. (x,y,z) representing this point.  My protocols are modelled on those
  92. of class Point.'!
  93.  
  94.  
  95. !ThreeDPoint methodsFor: 'accessing'!
  96.  
  97. refPoint
  98.     "Answer with a ThreeDPoint which is the 'reference point'
  99.      used when the object is first added to a compound object."
  100.  
  101.     ^self!
  102.  
  103. x
  104.     "Answer the x coordinate."
  105.  
  106.     ^x!
  107.  
  108. x: xInteger 
  109.     "Set the x coordinate."
  110.  
  111.     x _ xInteger!
  112.  
  113. y
  114.     "Answer the y coordinate."
  115.  
  116.     ^y!
  117.  
  118. y: yInteger 
  119.     "Set the y coordinate."
  120.  
  121.     y _ yInteger!
  122.  
  123. z
  124.     "Answer the z coordinate."
  125.  
  126.     ^z!
  127.  
  128. z: zInteger 
  129.     "Set the z coordinate."
  130.  
  131.     z _ zInteger! !
  132.  
  133. !ThreeDPoint methodsFor: 'comparing'!
  134.  
  135. < aPoint 
  136.  
  137.     ^(x < aPoint x and: [y < aPoint y]) and: [z < aPoint z]!
  138.  
  139. <= aPoint 
  140.  
  141.     ^(x <= aPoint x and: [y <= aPoint y]) and: [z <= aPoint z]!
  142.  
  143. = aPoint 
  144.  
  145.     self species = aPoint species
  146.         ifTrue: [^(x = aPoint x and: [y = aPoint y]) and: [z = aPoint z]]
  147.         ifFalse: [^false]!
  148.  
  149. > aPoint 
  150.  
  151.     ^(x > aPoint x and: [y > aPoint y]) and: [z > aPoint z]!
  152.  
  153. >= aPoint 
  154.  
  155.     ^(x >= aPoint x and: [y >= aPoint y]) and: [z >= aPoint z]!
  156.  
  157. hash
  158.     ^((x hash bitShift: 4) bitXor: (y hash bitShift: 2)) bitXor: z hash!
  159.  
  160. hashMappedBy: map
  161.     "My hash is independent of my oop."
  162.  
  163.     ^ self hash!
  164.  
  165. max: aPoint 
  166.  
  167.     ^ThreeDPoint
  168.         x: (x max: aPoint x)
  169.         y: (y max: aPoint y)
  170.         z: (z max: aPoint z)!
  171.  
  172. max: maxPoint min: minPoint 
  173.  
  174.     ^ThreeDPoint
  175.         x: (x max: minPoint x min: maxPoint x)
  176.         y: (y max: minPoint y min: maxPoint y)
  177.         z: (z max: minPoint z min: maxPoint z)!
  178.  
  179. min: aPoint 
  180.  
  181.     ^ThreeDPoint
  182.         x: (x min: aPoint x)
  183.         y: (y min: aPoint y)
  184.         z: (z min: aPoint z)! !
  185.  
  186. !ThreeDPoint methodsFor: 'modifying'!
  187.  
  188. moveTo: aThreeDPoint
  189.     "Modify the receiver so that it co-encides with aThreeDPoint."
  190.  
  191.     self x: aThreeDPoint x.
  192.     self y: aThreeDPoint y.
  193.     self z: aThreeDPoint z! !
  194.  
  195. !ThreeDPoint methodsFor: 'arithmetic'!
  196.  
  197. * scale 
  198.     "Answer a new ThreeDPoint that is the product of the 
  199.      receiver and scale (which is a ThreeDPoint or Number)."
  200.  
  201.     | scaleThreeDPoint |
  202.     scaleThreeDPoint _ scale asThreeDPoint.
  203.     ^ThreeDPoint
  204.         x: x * scaleThreeDPoint x
  205.         y: y * scaleThreeDPoint y
  206.         z: z * scaleThreeDPoint z!
  207.  
  208. + delta 
  209.     "Answer a new ThreeDPoint that is the sum of the 
  210.      receiver and delta (which is a ThreeDPoint or Number)."
  211.  
  212.     | deltaThreeDPoint |
  213.     deltaThreeDPoint _ delta asThreeDPoint.
  214.     ^ThreeDPoint
  215.         x: x + deltaThreeDPoint x
  216.         y: y + deltaThreeDPoint y
  217.         z: z + deltaThreeDPoint z!
  218.  
  219. - delta 
  220.     "Answer a new ThreeDPoint that is the difference of the 
  221.      receiver and delta (which is a ThreeDPoint or Number)."
  222.  
  223.     | deltaThreeDPoint |
  224.     deltaThreeDPoint _ delta asThreeDPoint.
  225.     ^ThreeDPoint
  226.         x: x - deltaThreeDPoint x
  227.         y: y - deltaThreeDPoint y
  228.         z: z - deltaThreeDPoint z!
  229.  
  230. / scale 
  231.     "Answer a new ThreeDPoint that is the quotient of the 
  232.      receiver and scale (which is a ThreeDPoint or Number)."
  233.  
  234.     | scaleThreeDPoint |
  235.     scaleThreeDPoint _ scale asThreeDPoint.
  236.     ^ThreeDPoint
  237.         x: x / scaleThreeDPoint x
  238.         y: y / scaleThreeDPoint y
  239.         z: z / scaleThreeDPoint z!
  240.  
  241. // scale 
  242.     "Answer a new ThreeDPoint that is the quotient of the 
  243.      receiver and scale (which is a ThreeDPoint or Number)."
  244.  
  245.     | scaleThreeDPoint |
  246.     scaleThreeDPoint _ scale asThreeDPoint.
  247.     ^ThreeDPoint
  248.         x: x // scaleThreeDPoint x
  249.         y: y // scaleThreeDPoint y
  250.         z: z // scaleThreeDPoint z!
  251.  
  252. abs
  253.     "Answer a new ThreeDPoint whose x, y and z are the absolute 
  254.      values of the receiver's x, y and z."
  255.  
  256.     ^ThreeDPoint
  257.         x: x abs
  258.         y: y abs
  259.         z: z abs!
  260.  
  261. negated
  262.     "Answer a new ThreeDPoint whose x, y and z are the negated
  263.      values of the receiver's x, y and z."
  264.  
  265.     ^ThreeDPoint
  266.         x: x negated
  267.         y: y negated
  268.         z: z negated! !
  269.  
  270. !ThreeDPoint methodsFor: 'truncation and rounding'!
  271.  
  272. rounded
  273.     "Answer a new ThreeDPoint whose x, y and z are the rounded
  274.      values of the receiver's x, y and z."
  275.  
  276.     ^ThreeDPoint
  277.         x: x rounded
  278.         y: y rounded
  279.         z: z rounded!
  280.  
  281. truncated
  282.     "Answer a new ThreeDPoint whose x, y and z are the truncated
  283.      values of the receiver's x, y and z."
  284.  
  285.     ^ThreeDPoint
  286.         x: x truncated
  287.         y: y truncated
  288.         z: z truncated!
  289.  
  290. truncateTo: grid 
  291.     "Answer a new ThreeDPoint that is the receiver's x, y and z 
  292.      truncated to grid x, grid y and grid x."
  293.  
  294.     (grid isKindOf: ThreeDPoint)
  295.         ifTrue: [
  296.             ^ThreeDPoint
  297.                 x: (x truncateTo: grid x)
  298.                 y: (y truncateTo: grid y)
  299.                 z: (z truncateTo: grid z)]
  300.         ifFalse: [
  301.             ^ThreeDPoint
  302.                 x: (x truncateTo: grid)
  303.                 y: (y truncateTo: grid)
  304.                 z: (z truncateTo: grid)]! !
  305.  
  306. !ThreeDPoint methodsFor: 'polar coordinates'!
  307.  
  308. r
  309.     "Answer the receiver's radius in polar coordinate system."
  310.  
  311.     ^(self dotProduct: self) sqrt! !
  312.  
  313. !ThreeDPoint methodsFor: 'point functions'!
  314.  
  315. angle: aThreeDPoint 
  316.     "Answer with the angle (in degrees) between the vectors represented 
  317.      by aThreeDPoint and the receiver."
  318.  
  319.     | dotProduct |
  320.     dotProduct _ self dotProduct: aThreeDPoint.
  321.     ^(dotProduct / (self r * aThreeDPoint r)) arcCos radiansToDegrees!
  322.  
  323. crossProduct: aThreeDPoint
  324.     "Answer with a ThreeDPoint representing the cross-product
  325.      of the receiver and aThreeDPoint (considered as vectors)."
  326.  
  327.     ^ThreeDPoint
  328.         x: (aThreeDPoint z * self y) - (aThreeDPoint y * self z)
  329.         y: (aThreeDPoint x * self z) - (aThreeDPoint z * self x)
  330.         z: (aThreeDPoint y * self x) - (aThreeDPoint x * self y)!
  331.  
  332. dist: aThreeDPoint 
  333.     "Answer the distance between aThreeDPoint and the receiver."
  334.  
  335.     ^(aThreeDPoint - self) r!
  336.  
  337. dotProduct: aThreeDPoint 
  338.     "Answer a Number that is the dot product of the receiver and
  339.      the argument, aThreeDPoint.  That is, the two points are
  340.      multipled and the coordinates of the result summed."
  341.  
  342.     | temp |
  343.     temp _ self * aThreeDPoint.
  344.     ^temp x abs + temp y abs + temp z abs!
  345.  
  346. grid: aThreeDPoint 
  347.     "Answer a new ThreeDPoint to the nearest rounded grid modules 
  348.      specified by aThreeDPoint."
  349.  
  350.     | newX newY newZ |
  351.     aThreeDPoint x = 0
  352.         ifTrue: [newX _ 0]
  353.         ifFalse: [newX _ x roundTo: aThreeDPoint x].
  354.     aThreeDPoint y = 0
  355.         ifTrue: [newY _ 0]
  356.         ifFalse: [newY _ y roundTo: aThreeDPoint y].
  357.     aThreeDPoint z = 0
  358.         ifTrue: [newZ _ 0]
  359.         ifFalse: [newZ _ z roundTo: aThreeDPoint z].
  360.     ^ThreeDPoint
  361.         x: newX
  362.         y: newY
  363.         z: newZ!
  364.  
  365. isPerpendicularTo: aThreeDPoint
  366.     "Answer true if the vectors represented by aThreeDPoint
  367.      and the receiver are perpendicular, otherwise false."
  368.  
  369.     ^(self dotProduct: aThreeDPoint) = 0! !
  370.  
  371. !ThreeDPoint methodsFor: 'converting'!
  372.  
  373. asPoint
  374.     "Answer with a Point representing the x and y coordinates of
  375.      the receiver."
  376.  
  377.     ^x@y!
  378.  
  379. asThreeDPoint
  380.     "Answer the receiver itself."
  381.  
  382.     ^self! !
  383.  
  384. !ThreeDPoint methodsFor: 'coercing'!
  385.  
  386. coerce: aNumber 
  387.  
  388.     ^ThreeDPoint
  389.         x: aNumber
  390.         y: aNumber
  391.         z: aNumber!
  392.  
  393. generality
  394.     ^90! !
  395.  
  396. !ThreeDPoint methodsFor: 'transforming'!
  397.  
  398. rotateBy: rot
  399.     "Answer with a new ThreeDPoint rotated by rot."
  400.  
  401.     ^ThreeDPoint
  402.         x: (x * (rot at: 1)) + (y * (rot at: 4)) + (z * (rot at: 7))
  403.         y: (x * (rot at: 2)) + (y * (rot at: 5)) + (z * (rot at: 8))
  404.         z: (x * (rot at: 3)) + (y * (rot at: 6)) + (z * (rot at: 9))!
  405.  
  406. scaleBy: factor 
  407.     "Answer a new ThreeDPoint scaled by factor (an  
  408.      instance of ThreeDPoint or Number)."
  409.  
  410.     (factor isKindOf: Number)
  411.         ifTrue: [^ThreeDPoint
  412.                 x: factor * x
  413.                 y: factor * y
  414.                 z: factor * z]
  415.         ifFalse: [^ThreeDPoint
  416.                 x: factor x * x
  417.                 y: factor y * y
  418.                 z: factor z * z]!
  419.  
  420. translateBy: delta 
  421.     "Answer a new ThreeDPoint translated by delta (an  
  422.      instance of ThreeDPoint or Number)."
  423.  
  424.     (delta isKindOf: Number)
  425.         ifTrue: [^ThreeDPoint
  426.                 x: delta + x
  427.                 y: delta + y
  428.                 z: delta + z]
  429.         ifFalse: [^ThreeDPoint
  430.                 x: delta x + x
  431.                 y: delta y + y
  432.                 z: delta z + z]! !
  433.  
  434. !ThreeDPoint methodsFor: 'copying'!
  435.  
  436. deepCopy
  437.     "Implemented here for better performance."
  438.  
  439.     ^ThreeDPoint
  440.         x: x deepCopy
  441.         y: y deepCopy
  442.         z: z deepCopy!
  443.  
  444. shallowCopy
  445.     "Implemented here for better performance."
  446.  
  447.     ^ThreeDPoint
  448.         x: x
  449.         y: y
  450.         z: z! !
  451.  
  452. !ThreeDPoint methodsFor: 'printing'!
  453.  
  454. printOn: aStream 
  455.     "The receiver prints on aStream in terms of infix notation."
  456.  
  457.     x printOn: aStream.
  458.     aStream nextPut: $@.
  459.     y printOn: aStream.
  460.     aStream nextPut: $@.
  461.     z printOn: aStream!
  462.  
  463. storeOn: aStream
  464.  
  465.     aStream nextPut: $(;
  466.     nextPutAll: self species name;
  467.     nextPutAll: ' x: ';
  468.     store: x;
  469.     nextPutAll: ' y: ';
  470.     store: y;
  471.     nextPutAll: ' z: ';
  472.     store: z;
  473.     nextPut: $).! !
  474.  
  475. !ThreeDPoint methodsFor: 'private'!
  476.  
  477. setX: xPoint setY: yPoint setZ: zPoint
  478.     x _ xPoint.
  479.     y _ yPoint.
  480.     z _ zPoint! !
  481. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  482.  
  483. ThreeDPoint class
  484.     instanceVariableNames: ''!
  485.  
  486.  
  487. !ThreeDPoint class methodsFor: 'instance creation'!
  488.  
  489. x: xInteger y: yInteger z: zInteger
  490.     "Answer a new instance of me with coordinates xInteger,
  491.      yInteger and zInteger."
  492.  
  493.     ^self new setX: xInteger setY: yInteger setZ: zInteger! !
  494.  
  495. Model subclass: #ThreeDObject
  496.     instanceVariableNames: 'cachedLines '
  497.     classVariableNames: ''
  498.     poolDictionaries: ''
  499.     category: 'Three-D-Graphics'!
  500. ThreeDObject comment:
  501. 'I am the abstract superclass of viewable three-dimensional objects.  I
  502. support a cached copy of the lines representing instances of my subclasses.
  503. All ThreeDObjects can be converted to an OrderedCollection of ThreeDLines,
  504. or an OrderedCollection of ThreeDPlanes.  Also, all ThreeDObjects have
  505. a default instance creation method.
  506. '!
  507.  
  508.  
  509. !ThreeDObject methodsFor: 'accessing'!
  510.  
  511. center
  512.     "Answer with a ThreeDPoint representing the center of
  513.      the receiver. By default, the center is the 'average' of the vertices."
  514.  
  515.     | sum |
  516.     sum _ ThreeDPoint x: 0.0 y: 0.0 z: 0.0.
  517.     self vertices do: [:eachVertex | sum _ sum + eachVertex].
  518.     ^sum / (self vertices size)!
  519.  
  520. findVertexNear: aPoint
  521.     "Answer with the vertex very close to aPoint (just to
  522.      overcome rounding errors).  Answer nil if none are sufficiently
  523.      close."
  524.  
  525.     ^self vertices detect: [:each | (each dist: aPoint) < 1.0] ifNone: [^nil]!
  526.  
  527. refPoint
  528.     "Answer with a ThreeDPoint which is the 'reference point'
  529.      used when the object is first added to a compound object."
  530.  
  531.     self subclassResponsibility!
  532.  
  533. vertices
  534.     "Answer with an OrderedCollection of ThreeDPoints representing the
  535.      vertices of the receiver.  All ThreeDObjects should respond to this message."
  536.  
  537.     self subclassResponsibility! !
  538.  
  539. !ThreeDObject methodsFor: 'comparing'!
  540.  
  541. = aThreeDObject
  542.     "All ThreeDObjects should implement this message."
  543.  
  544.     self subclassResponsibility!
  545.  
  546. hashMappedBy: map
  547.     "My hash is independent of my oop."
  548.  
  549.     ^ self hash! !
  550.  
  551. !ThreeDObject methodsFor: 'testing'!
  552.  
  553. includesVertex: aVertex
  554.     "Answer true if the receiver contains a vertex at aVertex, otherwise false."
  555.  
  556.     self vertices detect: [:eachVertex |
  557.         eachVertex = aVertex] ifNone: [^false].
  558.     ^true! !
  559.  
  560. !ThreeDObject methodsFor: 'modifying'!
  561.  
  562. addObject: anObject
  563.     "Add anObject to the collection of objects representing the receiver."
  564.  
  565.     self error: 'You cannot add to an primitive object'!
  566.  
  567. changed
  568.     "The model has changed, so delete the cached copy of the
  569.      lines representing the model."
  570.  
  571.     cachedLines _ nil.
  572.     super changed!
  573.  
  574. moveObject: vertex to: newPoint
  575.     "Move the entire object so that vertex is at newPoint.  All
  576.      ThreeDObjects should respond to this message."
  577.  
  578.     self subclassResponsibility!
  579.  
  580. moveVertex: vertex to: newPoint
  581.     "Move this vertex to newPoint.  All ThreeDObjects should respond to
  582.      this message."
  583.  
  584.     self subclassResponsibility!
  585.  
  586. removeObject: vertex
  587.     "Remove the object containing vertex, but only if it is not the
  588.      sole object forming the model.  This method is overridden by
  589.      ThreeDModel."
  590.  
  591.     self error: 'You cannot remove the entire model'! !
  592.  
  593. !ThreeDObject methodsFor: 'converting'!
  594.  
  595. asLines
  596.     "All ThreeDObjects can be converted into an OrderedCollection of ThreeDLines."
  597.  
  598.     self subclassResponsibility!
  599.  
  600. asPlanes
  601.     "All ThreeDObjects can be converted into an OrderedCollection of ThreeDPlanes."
  602.  
  603.     self subclassResponsibility! !
  604.  
  605. !ThreeDObject methodsFor: 'copying'!
  606.  
  607. copy
  608.     ^self deepCopy! !
  609. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  610.  
  611. ThreeDObject class
  612.     instanceVariableNames: ''!
  613.  
  614.  
  615. !ThreeDObject class methodsFor: 'instance creation'!
  616.  
  617. default
  618.     "Answer with an instance of the receiver, with default size and
  619.      position.  All ThreeDObjects should respond to this message."
  620.  
  621.     self subclassResponsibility! !
  622.  
  623. ThreeDObject subclass: #ThreeDLine
  624.     instanceVariableNames: 'start end '
  625.     classVariableNames: ''
  626.     poolDictionaries: ''
  627.     category: 'Three-D-Graphics'!
  628. ThreeDLine comment:
  629. 'I represent a straight line the 3-D.  My two instance variables,
  630. ''start'' and ''end'' are ThreeDPoints.'!
  631.  
  632.  
  633. !ThreeDLine methodsFor: 'accessing'!
  634.  
  635. end
  636.     "Answer with a ThreeDPoint representing the end of the receiver."
  637.  
  638.     ^end!
  639.  
  640. end: aThreeDPoint
  641.     "Set the ThreeDPoint representing the end of the receiver."
  642.  
  643.     end _ aThreeDPoint!
  644.  
  645. length
  646.     "Answer with the length of the receiver."
  647.  
  648.     ^(start - end) r!
  649.  
  650. refPoint
  651.     "Answer with a ThreeDPoint which is the 'reference point'
  652.      used when the object is first added to a compound object."
  653.  
  654.     ^self start!
  655.  
  656. start
  657.     "Answer with a ThreeDPoint representing the start of the receiver."
  658.  
  659.     ^start!
  660.  
  661. start: aThreeDPoint
  662.     "Set the ThreeDPoint representing the start of the receiver."
  663.  
  664.     start _ aThreeDPoint!
  665.  
  666. start: startPoint end: endPoint
  667.     "Set the start and end points of the receiver."
  668.  
  669.     start _ startPoint.
  670.     end _ endPoint!
  671.  
  672. vertices
  673.     "Answer with an OrderedCollection containing the end points
  674.      of the receiver."
  675.  
  676.     ^OrderedCollection with: start with: end! !
  677.  
  678. !ThreeDLine methodsFor: 'testing'!
  679.  
  680. isZeroLength
  681.     "Answer whether the receiver has a zero length."
  682.  
  683.     ^start = end! !
  684.  
  685. !ThreeDLine methodsFor: 'comparing'!
  686.  
  687. = aThreeDLine
  688.     "Answer whether the receiver and aThreeDLine are equal."
  689.  
  690.     self species = aThreeDLine species
  691.         ifTrue: [^start = aThreeDLine start and: [end = aThreeDLine end]]
  692.         ifFalse: [^false]!
  693.  
  694. hash
  695.  
  696.     ^start hash bitXor: end hash!
  697.  
  698. hashMappedBy: map
  699.     "My hash is independent of my oop."
  700.  
  701.     ^ self hash! !
  702.  
  703. !ThreeDLine methodsFor: 'modifying'!
  704.  
  705. moveObject: vertex to: newPoint
  706.     "Move the entire line so that vertex is at newPoint."
  707.  
  708.     | delta |
  709.     delta _ newPoint - vertex.
  710.     start moveTo: start + delta.
  711.     end moveTo: end + delta.
  712.     self changed!
  713.  
  714. moveVertex: vertex to: newPoint
  715.     "Move the end of the line (vertex) to newPoint."
  716.  
  717.     vertex == start ifTrue: [start moveTo: newPoint] ifFalse: [
  718.         vertex == end ifTrue: [end moveTo: newPoint]].
  719.     self changed! !
  720.  
  721. !ThreeDLine methodsFor: 'truncation and rounding'!
  722.  
  723. rounded
  724.     "Answer a ThreeDLine whose start and end are rounded."
  725.  
  726.     ^ThreeDLine start: start rounded end: end rounded!
  727.  
  728. truncated
  729.     "Answer a ThreeDLine whose start and end are truncated."
  730.  
  731.     ^ThreeDLine start: start truncated end: end truncated! !
  732.  
  733. !ThreeDLine methodsFor: 'converting'!
  734.  
  735. asLines
  736.     "Answer with an OrderedCollection containing the receiver.  This
  737.      method is included for compatibility."
  738.  
  739.     cachedLines isNil ifTrue: [
  740.         cachedLines _ OrderedCollection with: self].
  741.     ^cachedLines!
  742.  
  743. asPlanes
  744.     "Answer with an OrderedCollection containing a plane (with two
  745.      points!!) representing the receiver.  This method is included for
  746.      compatibility."
  747.  
  748.     ^OrderedCollection with: (ThreeDPlane with: self start with: self end)! !
  749.  
  750. !ThreeDLine methodsFor: 'transforming'!
  751.  
  752. rotateBy: aRotation 
  753.     "Answer a new ThreeDLine rotated by aRotation."
  754.  
  755.     ^ThreeDLine
  756.         start: (start rotateBy: aRotation)
  757.         end: (end rotateBy: aRotation)!
  758.  
  759. scaleBy: aThreeDPoint 
  760.     "Answer a new ThreeDLine scaled by aThreeDPoint."
  761.  
  762.     ^ThreeDLine
  763.         start: (start scaleBy: aThreeDPoint)
  764.         end: (end scaleBy: aThreeDPoint)!
  765.  
  766. translateBy: aThreeDPoint 
  767.     "Answer a new ThreeDLine translated by aThreeDPoint."
  768.  
  769.     ^ThreeDLine
  770.         start: (start translateBy: aThreeDPoint)
  771.         end: (end translateBy: aThreeDPoint)! !
  772.  
  773. !ThreeDLine methodsFor: 'point functions'!
  774.  
  775. grid: aThreeDPoint 
  776.     "Answer with a new ThreeDLine, with the endpoints 
  777.      rounded to a grid given by aThreeDPoint."
  778.  
  779.     ^ThreeDLine
  780.         start: (start grid: aThreeDPoint)
  781.         end: (end grid: aThreeDPoint)! !
  782.  
  783. !ThreeDLine methodsFor: 'printing'!
  784.  
  785. printOn: aStream
  786.     "The receiver prints on aStream."
  787.  
  788.     aStream nextPut: $(.
  789.     start printOn: aStream.
  790.     aStream nextPutAll: ' to '.
  791.     end printOn: aStream.
  792.     aStream nextPut: $)! !
  793. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  794.  
  795. ThreeDLine class
  796.     instanceVariableNames: ''!
  797.  
  798.  
  799. !ThreeDLine class methodsFor: 'instance creation'!
  800.  
  801. start: startPoint end: endPoint
  802.     "Answer with a new instance of me with the start and end
  803.      points given."
  804.  
  805.     ^self new start: startPoint end: endPoint! !
  806.  
  807. ThreeDObject subclass: #UnitVector
  808.     instanceVariableNames: ''
  809.     classVariableNames: ''
  810.     poolDictionaries: ''
  811.     category: 'Three-D-Graphics'!
  812. UnitVector comment:
  813. 'I represent a ThreeDObject corresponding to the unit vector <x,y,z>.  My
  814. principle use is to provide a model for reference purposes (in views).'!
  815.  
  816.  
  817. !UnitVector methodsFor: 'accessing'!
  818.  
  819. center
  820.     "Answer with a ThreeDpoint representing the center of the receiver."
  821.  
  822.     ^ThreeDPoint x: 0 y: 0 z: 0!
  823.  
  824. refPoint
  825.     "Answer with a ThreeDPoint which is the 'reference point'
  826.      used when the object is first added to a compound object."
  827.  
  828.     ^(ThreeDPoint x: 0 y: 0 z: 0)!
  829.  
  830. vertices
  831.     "Answer with an OrderedCollection of the vertices
  832.      represented by the receiver."
  833.  
  834.     ^OrderedCollection
  835.         with: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  836.         with: (ThreeDPoint x: 1.0 y: 0.0 z: 0.0)
  837.         with: (ThreeDPoint x: 0.0 y: 1.0 z: 0.0)
  838.         with: (ThreeDPoint x: 0.0 y: 0.0 z: 1.0)!
  839.  
  840. xLine
  841.     "Answer with a ThreeDLine representing the x-axis of the receiver."
  842.  
  843.     ^ThreeDLine
  844.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  845.             end: (ThreeDPoint x: 1.0 y: 0.0 z: 0.0)!
  846.  
  847. yLine
  848.     "Answer with a ThreeDLine representing the y-axis of the receiver."
  849.  
  850.     ^ThreeDLine
  851.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  852.             end: (ThreeDPoint x: 0.0 y: 1.0 z: 0.0)!
  853.  
  854. zLine
  855.     "Answer with a ThreeDLine representing the z-axis of the receiver."
  856.  
  857.     ^ThreeDLine
  858.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  859.             end: (ThreeDPoint x: 0.0 y: 0.0 z: 1.0)! !
  860.  
  861. !UnitVector methodsFor: 'comparing'!
  862.  
  863. = aUnitVector
  864.     "Since UnitVectors cannot be altered, they are always equal to
  865.      one another."
  866.  
  867.     ^aUnitVector class == UnitVector!
  868.  
  869. hashMappedBy: map
  870.     "Answer what my hash would be if oops changed according to map"
  871.     ^ map newHashFor: self hash! !
  872.  
  873. !UnitVector methodsFor: 'modifying'!
  874.  
  875. moveObject: vertex to: newPoint
  876.     "UnitVectors cannot be modified, so do nothing."!
  877.  
  878. moveVertex: vertex to: newPoint
  879.     "UnitVectors cannot be modified, so do nothing."! !
  880.  
  881. !UnitVector methodsFor: 'converting'!
  882.  
  883. asLines
  884.     "Answer with an OrderedCollection of ThreeDLines representing
  885.      the receiver."
  886.  
  887.     ^OrderedCollection
  888.         with: (ThreeDLine
  889.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  890.             end: (ThreeDPoint x: 1.0 y: 0.0 z: 0.0))
  891.         with: (ThreeDLine
  892.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  893.             end: (ThreeDPoint x: 0.0 y: 1.0 z: 0.0))
  894.         with: (ThreeDLine
  895.             start: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  896.             end: (ThreeDPoint x: 0.0 y: 0.0 z:1.0))!
  897.  
  898. asPlanes
  899.     "Answer with an OrderedCollection of ThreeDplanes representing 
  900.      the receiver."
  901.  
  902.     ^OrderedCollection
  903.         with: (ThreeDPlane
  904.             with: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  905.             with: (ThreeDPoint x: 1.0 y: 0.0 z: 0.0))
  906.         with: (ThreeDPlane
  907.             with: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  908.             with: (ThreeDPoint x: 0.0 y: 1.0 z: 0.0))
  909.         with: (ThreeDPlane
  910.             with: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  911.             with: (ThreeDPoint x: 0.0 y: 0.0 z: 1.0))! !
  912. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  913.  
  914. UnitVector class
  915.     instanceVariableNames: ''!
  916.  
  917.  
  918. !UnitVector class methodsFor: 'instance creation'!
  919.  
  920. default
  921.     "All UnitVectors are the same."
  922.  
  923.     ^self new! !
  924.  
  925. ThreeDObject subclass: #Parallelogram
  926.     instanceVariableNames: 'origin horiz vert '
  927.     classVariableNames: ''
  928.     poolDictionaries: ''
  929.     category: 'Three-D-Graphics'!
  930. Parallelogram comment:
  931. 'I represent a planar parallelogram in 3-D.  My instance variables:
  932.  
  933. origin    <ThreeDPoint> representing the origin (reference point).
  934. horiz    <ThreeDPoint> representing one of my extents.
  935. vert    <ThreeDPoint> representing the other extent.'!
  936.  
  937.  
  938. !Parallelogram methodsFor: 'accessing'!
  939.  
  940. bottomLeft
  941.     "Answer with a ThreeDPoint representing the 'bottom left' corner
  942.      of the receiver."
  943.  
  944.     ^vert!
  945.  
  946. bottomRight
  947.     "Answer with a ThreeDPoint representing the 'bottom right' corner
  948.      of the receiver."
  949.  
  950.     ^vert - origin + horiz!
  951.  
  952. horiz
  953.     "Answer with a ThreeDPoint representing the horizontal
  954.      extent of the receiver."
  955.  
  956.     ^horiz!
  957.  
  958. horiz: aThreeDPoint
  959.     "Set the horizontal extent of the receiver to be aThreeDPoint."
  960.  
  961.     horiz _ aThreeDPoint!
  962.  
  963. origin
  964.     "Answer with a ThreeDPoint representing the origin of the receiver."
  965.  
  966.     ^origin!
  967.  
  968. origin: aThreeDPoint
  969.     "Set the origin of the receiver to be aThreeDPoint."
  970.  
  971.     origin _ aThreeDPoint!
  972.  
  973. origin: orig horiz: h vert: v
  974.     "Set the receiver's origin horizontal and vertical locations
  975.      as given by the arguments."
  976.  
  977.     origin _ orig.
  978.     vert _ v.
  979.     horiz _ h!
  980.  
  981. origin: orig horizExtent: h vertExtent: v
  982.     "Set the receiver's origin, and the horizontal and vertical extents
  983.      as given by the arguments."
  984.  
  985.     origin _ orig.
  986.     vert _ v - orig.
  987.     horiz _ h - orig!
  988.  
  989. refPoint
  990.     "Answer with a ThreeDPoint which is the 'reference point'
  991.      used when the object is first added to a compound object.
  992.      In this case, the reference point is the origin"
  993.  
  994.     ^origin!
  995.  
  996. topLeft
  997.     "Answer with a ThreeDPoint representing the 'top left' corner
  998.      of the receiver."
  999.  
  1000.     ^origin!
  1001.  
  1002. topRight
  1003.     "Answer with a ThreeDPoint representing the 'top right' corner
  1004.      of the receiver."
  1005.  
  1006.     ^horiz!
  1007.  
  1008. vert
  1009.     "Answer with a ThreeDPoint representing the vertical
  1010.      extent of the receiver."
  1011.  
  1012.     ^vert!
  1013.  
  1014. vert: aThreeDPoint
  1015.     "Set the vertical extent of the receiver to be aThreeDPoint."
  1016.  
  1017.     vert _ aThreeDPoint!
  1018.  
  1019. vertices
  1020.     "Answer with an OrderedCollection containing the end points 
  1021.      of the receiver."
  1022.  
  1023.     ^OrderedCollection
  1024.         with: self topLeft
  1025.         with: self topRight
  1026.         with: self bottomLeft
  1027.         with: self bottomRight! !
  1028.  
  1029. !Parallelogram methodsFor: 'comparing'!
  1030.  
  1031. = aParallelogram 
  1032.     "Answer true if the receiver's species, origin, and horizontal 
  1033.      and vertical extents match aParallelogram's."
  1034.  
  1035.     self species = aParallelogram species
  1036.         ifTrue: [^(origin = aParallelogram origin and: [horiz = aParallelogram horiz])
  1037.                 and: [vert = aParallelogram vert]]
  1038.         ifFalse: [^false]!
  1039.  
  1040. hash
  1041.  
  1042.     ^(origin hash bitXor: horiz hash) bitXor: vert hash! !
  1043.  
  1044. !Parallelogram methodsFor: 'modifying'!
  1045.  
  1046. moveObject: vertex to: newPoint
  1047.     "Move the entire object so that vertex is at newPoint."
  1048.  
  1049.     | delta |
  1050.     delta _ newPoint - vertex.
  1051.     self horiz moveTo: horiz + delta.
  1052.     self vert moveTo: vert + delta.
  1053.     self origin moveTo: origin + delta.
  1054.     vertex moveTo: newPoint.
  1055.     self changed!
  1056.  
  1057. moveVertex: vertex to: newPoint
  1058.     "Move this vertex to newPoint.  Re-align the receiver appropriately."
  1059.  
  1060.     | delta |
  1061.     delta _ (newPoint - vertex) / 2.
  1062.     (self oppositeVertexTo: vertex) moveTo: (self oppositeVertexTo: vertex).
  1063.     (self nearestVerticesTo: vertex) do: [:eachVertex |
  1064.         eachVertex moveTo: eachVertex + delta].
  1065.     vertex moveTo: newPoint.
  1066.     self changed! !
  1067.  
  1068. !Parallelogram methodsFor: 'truncation and rounding'!
  1069.  
  1070. rounded
  1071.     "Answer with a new Parallelogram whose origin, and horizontal
  1072.      and vertical sizes are rounded."
  1073.  
  1074.     ^Parallelogram origin: origin rounded horiz: horiz rounded vert: vert rounded!
  1075.  
  1076. truncated
  1077.     "Answer with a new Parallelogram whose origin, and horizontal
  1078.      and vertical sizes are truncated."
  1079.  
  1080.     ^Parallelogram origin: origin truncated horiz: horiz truncated vert: vert truncated! !
  1081.  
  1082. !Parallelogram methodsFor: 'converting'!
  1083.  
  1084. asLines
  1085.     "Answer with an OrderedCollection of lines representing the receiver."
  1086.  
  1087.     cachedLines isNil ifTrue: [
  1088.         cachedLines _ OrderedCollection
  1089.             with: (ThreeDLine start: self topLeft end: self topRight)
  1090.             with: (ThreeDLine start: self topLeft end: self bottomLeft)
  1091.             with: (ThreeDLine start: self bottomLeft end: self bottomRight)
  1092.             with: (ThreeDLine start: self topRight end: self bottomRight)].
  1093.     ^cachedLines!
  1094.  
  1095. asPlanes
  1096.     "Answer with an OrderedCollection containing a single
  1097.      ThreeDPlane representing the receiver."
  1098.  
  1099.     ^OrderedCollection with:
  1100.         (ThreeDPlane
  1101.             with: self topLeft with: self topRight
  1102.             with: self bottomRight with: self bottomLeft)! !
  1103.  
  1104. !Parallelogram methodsFor: 'transforming'!
  1105.  
  1106. rotateBy: aRotation 
  1107.     "Answer a new Parallelogram rotated by aRotation."
  1108.  
  1109.     ^Parallelogram
  1110.         origin: (origin rotateBy: aRotation)
  1111.         horiz: (horiz rotateBy: aRotation)
  1112.         vert: (vert rotateBy: aRotation)!
  1113.  
  1114. scaleBy: aThreeDPoint 
  1115.     "Answer a new Parallelogram scaled by aThreeDPoint."
  1116.  
  1117.     ^Parallelogram
  1118.         origin: (origin scaleBy: aThreeDPoint)
  1119.         horiz: (horiz scaleBy: aThreeDPoint)
  1120.         vert: (vert scaleBy: aThreeDPoint)!
  1121.  
  1122. translateBy: aThreeDPoint 
  1123.     "Answer a new Parallelogram translated by aThreeDPoint."
  1124.  
  1125.     ^Parallelogram
  1126.         origin: (origin translateBy: aThreeDPoint)
  1127.         horiz: (horiz translateBy: aThreeDPoint)
  1128.         vert: (vert translateBy: aThreeDPoint)! !
  1129.  
  1130. !Parallelogram methodsFor: 'private'!
  1131.  
  1132. nearestVerticesTo: vertex
  1133.     "Answer with an OrderedCollection containing the two vertices
  1134.      which are nearest to vertex."
  1135.  
  1136.     (vertex = self topLeft) ifTrue: [
  1137.         ^OrderedCollection with: self topRight with: self bottomLeft].
  1138.     (vertex = self topRight) ifTrue: [
  1139.         ^OrderedCollection with: self topLeft with: self bottomRight].
  1140.     (vertex = self bottomLeft) ifTrue: [
  1141.         ^OrderedCollection with: self topLeft with: self bottomRight].
  1142.     ^OrderedCollection with: self topRight with: self bottomLeft!
  1143.  
  1144. oppositeVertexTo: vertex
  1145.     "Answer with the vertex directly opposite vertex."
  1146.  
  1147.     (vertex = self topLeft) ifTrue: [^self bottomRight].
  1148.     (vertex = self topRight) ifTrue: [^self bottomLeft].
  1149.     (vertex = self bottomLeft) ifTrue: [^self topRight].
  1150.     ^self topLeft! !
  1151. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1152.  
  1153. Parallelogram class
  1154.     instanceVariableNames: ''!
  1155.  
  1156.  
  1157. !Parallelogram class methodsFor: 'instance creation'!
  1158.  
  1159. default
  1160.     "The default Parallelogram is a rectangle of size 3 by 4, centered
  1161.      on the origin, in the z=0 plane."
  1162.  
  1163.     ^self
  1164.         origin: (ThreeDPoint x: -1.5 y: -2.0 z: 0.0)
  1165.         horiz: (ThreeDPoint x: 1.5 y: -2.0 z: 0.0)
  1166.         vert: (ThreeDPoint x: -1.5 y: 2.0 z: 0.0)!
  1167.  
  1168. origin: orig horiz: h vert: v
  1169.     "Answer with a new instance of me with origin, and horizontal
  1170.      and vertical size given by the arguments."
  1171.  
  1172.     ^self new origin: orig horiz: h vert: v!
  1173.  
  1174. origin: orig horizExtent: h vertExtent: v
  1175.     "Answer with a new instance of me with origin, and horizontal
  1176.      and vertical extents given by the arguments."
  1177.  
  1178.     ^self new origin: orig horizExtent: h vertExtent: v! !
  1179.  
  1180. ThreeDObject subclass: #Cuboid
  1181.     instanceVariableNames: 'origin corner '
  1182.     classVariableNames: ''
  1183.     poolDictionaries: ''
  1184.     category: 'Three-D-Graphics'!
  1185. Cuboid comment:
  1186. 'I represent a class of objects which have cubical shape; i.e the
  1187. width, depth and height can be any size, but all angles are constrained
  1188. to be 90 degrees.  My instance variables are:
  1189.  
  1190. origin    <ThreeDPoint> representing the front, top, left corner of the instance.
  1191. corner    <ThreeDPoint> representing the back, bottom, right of the instance.
  1192.  
  1193. My protocol is modelled on that of class Rectangle.'!
  1194.  
  1195.  
  1196. !Cuboid methodsFor: 'accessing'!
  1197.  
  1198. back
  1199.     "Answer the position of the receiver's back vertical side."
  1200.  
  1201.     ^corner z!
  1202.  
  1203. bottom
  1204.     "Answer the position of the receiver's bottom horizontal side."
  1205.  
  1206.     ^corner y!
  1207.  
  1208. center
  1209.     "Answer with a ThreeDPoint representing the center of the receiver.  In
  1210.      this case, the center is the actual center of the Cuboid."
  1211.  
  1212.     ^(self origin + self corner) / 2!
  1213.  
  1214. corner
  1215.     "Answer with a ThreeDPoint representing the far bottom right
  1216.      corner of the receiver."
  1217.  
  1218.     ^corner!
  1219.  
  1220. corner: cornerPoint 
  1221.     "Set the far bottom right corner of the receiver."
  1222.  
  1223.     corner _ cornerPoint!
  1224.  
  1225. depth
  1226.     "Answer the depth of the receiver."
  1227.  
  1228.     ^corner z - origin z!
  1229.  
  1230. depth: widthInteger 
  1231.     "Change the receiver's far vertical side to make its depth
  1232.      widthInteger."
  1233.  
  1234.     corner z: origin z + widthInteger!
  1235.  
  1236. extent
  1237.     "Answer with a ThreeDPoint representing the extent (height,
  1238.      depth and width) of the receiver."
  1239.  
  1240.     ^corner - origin!
  1241.  
  1242. extent: extentPoint 
  1243.     "Set the extent (width, depth and height) of the receiver to be
  1244.      extentPoint."
  1245.  
  1246.     corner _ origin + extentPoint!
  1247.  
  1248. farBottomLeft
  1249.     "Answer with aThreeDPoint representing the far bottom left corner
  1250.      of the receiver."
  1251.  
  1252.     ^ThreeDPoint x: origin x y: corner y z: corner z!
  1253.  
  1254. farBottomRight
  1255.     "Answer with aThreeDPoint representing the far bottom right corner
  1256.      of the receiver."
  1257.  
  1258.     ^corner!
  1259.  
  1260. farTopLeft
  1261.     "Answer with aThreeDPoint representing the far top left corner
  1262.      of the receiver."
  1263.  
  1264.     ^ThreeDPoint x: origin x y: origin y z: corner z!
  1265.  
  1266. farTopRight
  1267.     "Answer with aThreeDPoint representing the far top right corner
  1268.      of the receiver."
  1269.  
  1270.     ^ThreeDPoint x: corner x y: origin y z: corner z!
  1271.  
  1272. front
  1273.     "Answer the position of the receiver's front vertical side."
  1274.  
  1275.     ^origin z!
  1276.  
  1277. height
  1278.     "Answer the height of the receiver."
  1279.  
  1280.     ^corner y - origin y!
  1281.  
  1282. height: heightInteger 
  1283.     "Change the receiver's bottom y to make its height heightInteger."
  1284.  
  1285.     corner y: origin y + heightInteger!
  1286.  
  1287. left
  1288.     "Answer the position of the receiver's left vertical side."
  1289.  
  1290.     ^origin x!
  1291.  
  1292. nearBottomLeft
  1293.     "Answer with aThreeDPoint representing the near bottom left corner
  1294.      of the receiver."
  1295.  
  1296.     ^ThreeDPoint x: origin x y: corner y z: origin z!
  1297.  
  1298. nearBottomRight
  1299.     "Answer with aThreeDPoint representing the near bottom right corner
  1300.      of the receiver."
  1301.  
  1302.     ^ThreeDPoint x: corner x y: corner y z: origin z!
  1303.  
  1304. nearTopLeft
  1305.     "Answer with aThreeDPoint representing the near top left corner
  1306.      of the receiver."
  1307.  
  1308.     ^origin!
  1309.  
  1310. nearTopRight
  1311.     "Answer with aThreeDPoint representing the near top right corner
  1312.      of the receiver."
  1313.  
  1314.     ^ThreeDPoint x: corner x y: origin y z: origin z!
  1315.  
  1316. origin
  1317.     "Answer with a ThreeDPoint representing the origin (near top left) of
  1318.      the receiver."
  1319.  
  1320.     ^origin!
  1321.  
  1322. origin: originPoint 
  1323.     "Set the origin of the receiver to originPoint."
  1324.  
  1325.     origin _ originPoint!
  1326.  
  1327. origin: originPoint corner: cornerPoint
  1328.     "Set the points at the near top left corner and the far bottom
  1329.      right corner of the receiver."
  1330.  
  1331.     origin _ originPoint.
  1332.     corner _ cornerPoint!
  1333.  
  1334. origin: originPoint extent: extentPoint
  1335.     "Set the point at the near top left corner of the receiver
  1336.      to be originPoint and set the width,depth and height of
  1337.      the receiver to be extentPoint."
  1338.  
  1339.     origin _ originPoint.
  1340.     corner _ origin + extentPoint!
  1341.  
  1342. refPoint
  1343.     "Answer with a ThreeDPoint which is the 'reference point'
  1344.      used when the object is first added to a compound object."
  1345.  
  1346.     ^origin!
  1347.  
  1348. right
  1349.     "Answer the position of the receiver's right vertical side."
  1350.  
  1351.     ^corner x!
  1352.  
  1353. top
  1354.     "Answer the position of the receiver's top horizontal side."
  1355.  
  1356.     ^origin y!
  1357.  
  1358. vertices
  1359.     "Answer with an OrderedCollection of the vertices represented by
  1360.      the receiver."
  1361.  
  1362.     | collection |
  1363.     collection _ OrderedCollection new.
  1364.     collection add: self farBottomLeft.
  1365.     collection add: self farBottomRight.
  1366.     collection add: self farTopLeft.
  1367.     collection add: self farTopRight.
  1368.     collection add: self nearBottomLeft.
  1369.     collection add: self nearBottomRight.
  1370.     collection add: self nearTopLeft.
  1371.     collection add: self nearTopRight.
  1372.     ^collection!
  1373.  
  1374. volume
  1375.     "Answer the receiver's volume, the product of width, depth and height."
  1376.  
  1377.     ^self width * self height * self depth!
  1378.  
  1379. width
  1380.     "Answer the width of the receiver."
  1381.  
  1382.     ^corner x - origin x!
  1383.  
  1384. width: widthInteger 
  1385.     "Change the receiver's right vertical side to make its width
  1386.      widthInteger."
  1387.  
  1388.     corner x: origin x + widthInteger! !
  1389.  
  1390. !Cuboid methodsFor: 'comparing'!
  1391.  
  1392. = aCuboid 
  1393.     "Answer true if the receiver's species, origin and corner match aCuboid's."
  1394.  
  1395.     self species = aCuboid species
  1396.         ifTrue: [^origin = aCuboid origin and: [corner = aCuboid corner]]
  1397.         ifFalse: [^false]!
  1398.  
  1399. hash
  1400.  
  1401.     ^origin hash bitXor: corner hash! !
  1402.  
  1403. !Cuboid methodsFor: 'testing'!
  1404.  
  1405. contains: aCuboid 
  1406.     "Answer whether the receiver is equal to aCuboid or whether aCuboid 
  1407.     is contained within the receiver."
  1408.  
  1409.     ^aCuboid origin >= origin and: [aCuboid corner <= corner]!
  1410.  
  1411. containsPoint: aThreeDPoint 
  1412.     "Answer whether aThreeDPoint is within the receiver."
  1413.  
  1414.     ^origin <= aThreeDPoint and: [aThreeDPoint < corner]!
  1415.  
  1416. intersects: aCuboid 
  1417.     "Answer whether aCuboid intersects the receiver anywhere."
  1418.  
  1419.     ^(origin max: aCuboid origin) < (corner min: aCuboid corner)! !
  1420.  
  1421. !Cuboid methodsFor: 'modifying'!
  1422.  
  1423. moveFarBottomLeft: newPoint
  1424.     "Move the FarBottomLeft vertex to newPoint.  The receiver has changed."
  1425.  
  1426.     self origin x: newPoint x.
  1427.     self corner y: newPoint y.
  1428.     self corner z: newPoint z.
  1429.     self changed!
  1430.  
  1431. moveFarBottomRight: newPoint
  1432.     "Move the FarBottomRight vertex to newPoint.  The receiver has changed."
  1433.  
  1434.     self corner moveTo: newPoint.
  1435.     self changed!
  1436.  
  1437. moveFarTopLeft: newPoint
  1438.     "Move the FarTopLeft vertex to newPoint.  The receiver has changed."
  1439.  
  1440.     self origin x: newPoint x.
  1441.     self origin y: newPoint y.
  1442.     self corner z: newPoint z.
  1443.     self changed!
  1444.  
  1445. moveFarTopRight: newPoint
  1446.     "Move the FarTopRight vertex to newPoint.  The receiver has changed."
  1447.  
  1448.     self corner x: newPoint x.
  1449.     self origin y: newPoint y.
  1450.     self corner z: newPoint z.
  1451.     self changed!
  1452.  
  1453. moveNearBottomLeft: newPoint
  1454.     "Move the NearBottomLeft vertex to newPoint.  The receiver has changed."
  1455.  
  1456.     self origin x: newPoint x.
  1457.     self corner y: newPoint y.
  1458.     self origin z: newPoint z.
  1459.     self changed!
  1460.  
  1461. moveNearBottomRight: newPoint
  1462.     "Move the NearBottomRight vertex to newPoint.  The receiver has changed."
  1463.  
  1464.     self corner x: newPoint x.
  1465.     self corner y: newPoint y.
  1466.     self origin z: newPoint z.
  1467.     self changed!
  1468.  
  1469. moveNearTopLeft: newPoint
  1470.     "Move the NearTopLeft vertex to newPoint.  The receiver has changed."
  1471.  
  1472.     self origin moveTo: newPoint.
  1473.     self changed!
  1474.  
  1475. moveNearTopRight: newPoint
  1476.     "Move the NearTopRight vertex to newPoint.  The receiver has changed."
  1477.  
  1478.     self corner x: newPoint x.
  1479.     self origin y: newPoint y.
  1480.     self origin z: newPoint z.
  1481.     self changed!
  1482.  
  1483. moveObject: vertex to: newPoint
  1484.     "Move the entire object so that vertex is at newPoint."
  1485.  
  1486.     | delta |
  1487.     delta _ newPoint - vertex.
  1488.     self corner moveTo: corner + delta.
  1489.     self origin moveTo: origin + delta.
  1490.     vertex moveTo: newPoint.
  1491.     self changed!
  1492.  
  1493. moveVertex: vertex to: newPoint
  1494.     "Move this vertex to newPoint, keeping the sides square to
  1495.      the axes."
  1496.  
  1497.     (vertex = self nearTopLeft) ifTrue: [^self moveNearTopLeft: newPoint].
  1498.     (vertex = self nearBottomLeft) ifTrue: [
  1499.         self moveNearBottomLeft: newPoint.
  1500.         ^vertex moveTo: self nearBottomLeft].
  1501.     (vertex = self nearBottomRight) ifTrue: [
  1502.         self moveNearBottomRight: newPoint.
  1503.         ^vertex moveTo: self nearBottomRight].
  1504.     (vertex = self nearTopRight) ifTrue: [
  1505.         self moveNearTopRight: newPoint.
  1506.         ^vertex moveTo: self nearTopRight].
  1507.  
  1508.     (vertex = self farBottomLeft) ifTrue: [
  1509.         self moveFarBottomLeft: newPoint.
  1510.         ^vertex moveTo: self farBottomLeft].
  1511.     (vertex = self farTopLeft) ifTrue: [
  1512.         self moveFarTopLeft: newPoint.
  1513.         ^vertex moveTo: self farTopLeft].
  1514.     (vertex = self farTopRight) ifTrue: [
  1515.         self moveFarTopRight: newPoint.
  1516.         ^vertex moveTo: self farTopRight].
  1517.     (vertex = self farBottomRight) ifTrue: [^self moveFarBottomRight: newPoint].! !
  1518.  
  1519. !Cuboid methodsFor: 'truncation and rounding'!
  1520.  
  1521. rounded
  1522.     "Answer a Cuboid whose origin and corner are rounded."
  1523.  
  1524.     ^Cuboid origin: origin rounded corner: corner rounded!
  1525.  
  1526. truncated
  1527.     "Answer a Cuboid whose origin and corner are truncated."
  1528.  
  1529.     ^Cuboid origin: origin truncated corner: corner truncated! !
  1530.  
  1531. !Cuboid methodsFor: 'converting'!
  1532.  
  1533. asLines
  1534.     "Answer with an OrderedCollection of lines representing the receiver."
  1535.  
  1536.     cachedLines isNil ifTrue: [
  1537.         cachedLines _ OrderedCollection new.
  1538.         cachedLines add:
  1539.             (ThreeDLine start: self nearTopLeft end: self nearTopRight).
  1540.         cachedLines add:
  1541.             (ThreeDLine start: self nearTopLeft end: self nearBottomLeft).
  1542.         cachedLines add:
  1543.             (ThreeDLine start: self nearTopRight end: self nearBottomRight).
  1544.         cachedLines add:
  1545.             (ThreeDLine start: self nearBottomLeft end: self nearBottomRight).
  1546.         cachedLines add:
  1547.             (ThreeDLine start: self farTopLeft end: self farTopRight).
  1548.         cachedLines add:
  1549.             (ThreeDLine start: self farTopLeft end: self farBottomLeft).
  1550.         cachedLines add:
  1551.             (ThreeDLine start: self farTopRight end: self farBottomRight).
  1552.         cachedLines add:
  1553.             (ThreeDLine start: self farBottomLeft end: self farBottomRight).
  1554.         cachedLines add:
  1555.             (ThreeDLine start: self nearTopLeft end: self farTopLeft).
  1556.         cachedLines add:
  1557.             (ThreeDLine start: self nearBottomLeft end: self farBottomLeft).
  1558.         cachedLines add:
  1559.             (ThreeDLine start: self nearTopRight end: self farTopRight).
  1560.         cachedLines add:
  1561.             (ThreeDLine start: self nearBottomRight end: self farBottomRight)].
  1562.     ^cachedLines!
  1563.  
  1564. asPlanes
  1565.     "Answer with an OrderedCollection of ThreeDPlanes representing
  1566.      the receiver."
  1567.  
  1568.     | collection |
  1569.     collection _ OrderedCollection new.
  1570.     collection add: (ThreeDPlane
  1571.                         with: self farTopLeft with: self farBottomLeft
  1572.                         with: self nearBottomLeft with: self nearTopLeft).
  1573.     collection add: (ThreeDPlane
  1574.                         with: self farTopLeft with: self farTopRight
  1575.                         with: self nearTopRight with: self nearTopLeft).
  1576.     collection add: (ThreeDPlane
  1577.                         with: self farTopRight with: self farBottomRight
  1578.                         with: self nearBottomRight with: self nearTopRight).
  1579.     collection add: (ThreeDPlane
  1580.                         with: self farBottomRight with: self farBottomLeft
  1581.                         with: self nearBottomLeft with: self nearBottomRight).
  1582.     collection add: (ThreeDPlane
  1583.                         with: self farBottomRight with: self farTopRight
  1584.                         with: self farTopLeft with: self farBottomLeft).
  1585.     collection add: (ThreeDPlane
  1586.                         with: self nearBottomRight with: self nearTopRight
  1587.                         with: self nearTopLeft with: self nearBottomLeft).
  1588.     ^collection! !
  1589.  
  1590. !Cuboid methodsFor: 'transforming'!
  1591.  
  1592. scaleBy: scale 
  1593.     "Answer a new Cuboid scaled by scale, a ThreeDPoint or a scalar."
  1594.  
  1595.     ^Cuboid origin: origin * scale corner: corner * scale!
  1596.  
  1597. translateBy: factor 
  1598.     "Answer a new Cuboid translated by factor, a ThreeDPoint or a scalar."
  1599.  
  1600.     ^Cuboid origin: origin + factor corner: corner + factor! !
  1601. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1602.  
  1603. Cuboid class
  1604.     instanceVariableNames: ''!
  1605.  
  1606.  
  1607. !Cuboid class methodsFor: 'instance creation'!
  1608.  
  1609. cube: aNumber 
  1610.     "Answer with a new instance of me representing a cube of 
  1611.      side aNumber, centered on the origin (0@0@0)."
  1612.  
  1613.     | halfSide |
  1614.     halfSide _ (aNumber / 2) asFloat.
  1615.     ^self
  1616.         left: 0 - halfSide
  1617.         right: halfSide
  1618.         top: 0 - halfSide
  1619.         bottom: halfSide
  1620.         front: 0 - halfSide
  1621.         back: halfSide!
  1622.  
  1623. default
  1624.     "The default Cuboid is a cube of side 5, centered on the origin."
  1625.  
  1626.     ^self cube: 5!
  1627.  
  1628. left: leftNumber right: rightNumber top: topNumber bottom: bottomNumber front: frontNumber back: backNumber
  1629.     "Answer an instance of me whose left, right, top, bottom, front
  1630.      and back coordinates are determined by the arguments."
  1631.  
  1632.     ^self
  1633.         origin: (ThreeDPoint x: leftNumber y: topNumber z: frontNumber)
  1634.         corner: (ThreeDPoint x: rightNumber y: bottomNumber z: backNumber)!
  1635.  
  1636. origin: originPoint corner: cornerPoint 
  1637.     "Answer an instance of me whose corners (near top left and
  1638.      far bottom right) are determined by the arguments."
  1639.  
  1640.     ^self new origin: originPoint corner: cornerPoint!
  1641.  
  1642. origin: originPoint extent: extentPoint 
  1643.     "Answer an instance of me whose near top left corner is originPoint
  1644.      and width, depth and height is given by extentPoint."
  1645.  
  1646.     ^self new origin: originPoint extent: extentPoint!
  1647.  
  1648. unitCube 
  1649.     "Answer with a new instance of me representing a unit cube (i.e
  1650.      with sides of 1), centered on the origin (0@0@0)."
  1651.  
  1652.     ^self cube: 1! !
  1653.  
  1654. ThreeDObject subclass: #Cone
  1655.     instanceVariableNames: 'apex base '
  1656.     classVariableNames: ''
  1657.     poolDictionaries: ''
  1658.     category: 'Three-D-Graphics'!
  1659. Cone comment:
  1660. 'I represent a concrete class of cones with pologonal bases.  My
  1661. instances variables are:
  1662.  
  1663. apex    <ThreeDPoint> representing the top of the cone.
  1664. base    <OrderedCollection> of <ThreeDPoint> representing the
  1665.         base of the cone.
  1666. '!
  1667.  
  1668.  
  1669. !Cone methodsFor: 'initialize-release'!
  1670.  
  1671. initialize
  1672.  
  1673.     base _ OrderedCollection new.! !
  1674.  
  1675. !Cone methodsFor: 'accessing'!
  1676.  
  1677. apex
  1678.     "Answer with a ThreeDPoint representing the apex of
  1679.      the receiver."
  1680.  
  1681.     ^apex!
  1682.  
  1683. apex: aThreeDPoint
  1684.     "Set the apex of the receiver."
  1685.  
  1686.     apex _ aThreeDPoint!
  1687.  
  1688. base
  1689.     "Answer with the OrderedCollection of ThreeDPoints
  1690.      representing the base of the receiver."
  1691.  
  1692.     ^base!
  1693.  
  1694. base: aCollection
  1695.     "Set the base of the receiver to be aCollection."
  1696.  
  1697.     base _ aCollection asOrderedCollection!
  1698.  
  1699. refPoint
  1700.     "Answer with a ThreeDPoint which is the 'reference point'
  1701.      used when the object is first added to a compound object."
  1702.  
  1703.     ^apex!
  1704.  
  1705. vertices
  1706.     "Answer with an OrderedCollection of the vertices represented
  1707.      by the receiver."
  1708.  
  1709.     | collection |
  1710.     collection _ self base copy.
  1711.     collection add: self apex.
  1712.     ^collection! !
  1713.  
  1714. !Cone methodsFor: 'comparing'!
  1715.  
  1716. = aCone
  1717.     "Answer true if the receiver's species, apex and base match aCone's."
  1718.  
  1719.     self species = aCone species
  1720.         ifTrue: [^apex = aCone apex and: [base = aCone base]]
  1721.         ifFalse: [^false]!
  1722.  
  1723. hash
  1724.  
  1725.     ^apex hash bitXor: base hash!
  1726.  
  1727. hashMappedBy: map
  1728.     "Answer what my hash would be if oops changed according to map"
  1729.     ^ map newHashFor: self hash! !
  1730.  
  1731. !Cone methodsFor: 'modifying'!
  1732.  
  1733. moveObject: vertex to: newPoint
  1734.     "Move the entire object so that vertex is at newPoint."
  1735.  
  1736.     | delta |
  1737.     delta _ newPoint - vertex.
  1738.     self apex moveTo: delta + apex.
  1739.     self base: (self base collect: [:each | each moveTo: delta + each]).
  1740.     self changed!
  1741.  
  1742. moveVertex: vertex to: newPoint
  1743.     "Move this vertex to newPoint."
  1744.  
  1745.     vertex == apex
  1746.         ifTrue: [self apex moveTo: newPoint]
  1747.         ifFalse: [
  1748.             self base: (self base collect: [:each | each == vertex
  1749.                   ifTrue: [each moveTo: newPoint]
  1750.                   ifFalse: [each]])].
  1751.     self changed! !
  1752.  
  1753. !Cone methodsFor: 'truncation and rounding'!
  1754.  
  1755. rounded
  1756.     "Answer with a Cone whose apex and base are rounded."
  1757.  
  1758.     ^Cone
  1759.         apex: apex rounded
  1760.         base: (base collect: [:eachPoint | eachPoint rounded])!
  1761.  
  1762. truncated
  1763.     "Answer with a Cone whose apex and base are truncated."
  1764.  
  1765.     ^Cone
  1766.         apex: apex truncated
  1767.         base: (base collect: [:eachPoint | eachPoint truncated])! !
  1768.  
  1769. !Cone methodsFor: 'converting'!
  1770.  
  1771. asLines
  1772.     "Answer with an OrderedCollection of ThreeDLines representing the receiver."
  1773.  
  1774.     | array |
  1775.     cachedLines isNil ifTrue: [
  1776.         cachedLines _ OrderedCollection new.
  1777.         array _ base asArray.
  1778.         1 to: (array size - 1) do: [ :i |
  1779.             cachedLines add: (ThreeDLine start: (array at: i) end: (array at: i + 1)).
  1780.             cachedLines add: (ThreeDLine start: (array at: i) end: apex)].
  1781.         cachedLines add: (ThreeDLine start: array last end: array first).
  1782.         cachedLines add: (ThreeDLine start: array last end: apex)].
  1783.     ^cachedLines!
  1784.  
  1785. asPlanes
  1786.     "Answer with an OrderedCollection of ThreeDPlanes representing
  1787.      the receiver."
  1788.  
  1789.     | collection array |
  1790.     collection _ OrderedCollection new.
  1791.     array _ base asArray.
  1792.     1 to: (array size - 1) do: [:i | collection add:
  1793.             (ThreeDPlane with: (array at: i) with: (array at: i + 1) with: apex)].
  1794.     collection add: (ThreeDPlane with: array last with: array first with: apex).
  1795.     collection add: (ThreeDPlane vertices:
  1796.         (OrderedCollection new addAll: array)).
  1797.     ^collection! !
  1798.  
  1799. !Cone methodsFor: 'transforming'!
  1800.  
  1801. translateBy: delta 
  1802.     "Answer a new Cone translated by delta (an  
  1803.      instance of ThreeDPoint or Number)."
  1804.  
  1805.     ^Cone
  1806.         apex: (apex translateBy: delta)
  1807.         base: (base collect: [:each | each translateBy: delta])! !
  1808. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1809.  
  1810. Cone class
  1811.     instanceVariableNames: ''!
  1812.  
  1813.  
  1814. !Cone class methodsFor: 'instance creation'!
  1815.  
  1816. apex: aThreeDPoint base: aCollection
  1817.     "create a new instance of me with the apex given by aThreeDPoint,
  1818.      and the base given by aCollection of ThreeDPoints."
  1819.  
  1820.     | cone |
  1821.     cone _ self new initialize.
  1822.     cone apex: aThreeDPoint.
  1823.     cone base: aCollection.
  1824.     ^cone!
  1825.  
  1826. apex: aThreeDPoint sides: aNumber radius: rad
  1827.     "Answer with a new instance of me with the apex at
  1828.      aThreeDPoint, and the base given by aNumber points
  1829.      of radius rad on the z=0 plane."
  1830.  
  1831.     | collection step |
  1832.     collection _ OrderedCollection new.
  1833.     step _ (360 / aNumber) degreesToRadians.
  1834.     0 to: aNumber - 1 do: [:count |
  1835.         collection add: (ThreeDPoint
  1836.                 x: (step * count) sin * rad
  1837.                 y: (step * count) cos * rad
  1838.                 z: 0.0)].
  1839.     ^self apex: aThreeDPoint base: collection!
  1840.  
  1841. default
  1842.     "The default Cone has a square base of side 5 on the x-y plane
  1843.      centered at the origin, with an apex on the z-axis +7 units
  1844.      from the base."
  1845.  
  1846.     ^Cone
  1847.         apex: (ThreeDPoint x: 0 y: 0 z: 7)
  1848.         base: (OrderedCollection
  1849.             with: (ThreeDPoint x: 5 y: 5 z: 0)
  1850.             with: (ThreeDPoint x: 5 y: -5 z: 0)
  1851.             with: (ThreeDPoint x: -5 y: -5 z: 0)
  1852.             with: (ThreeDPoint x: -5 y: 5 z: 0))!
  1853.  
  1854. new
  1855.  
  1856.     ^super new initialize! !
  1857.  
  1858. ThreeDObject subclass: #Parallelepiped
  1859.     instanceVariableNames: 'origin horiz vert depth '
  1860.     classVariableNames: ''
  1861.     poolDictionaries: ''
  1862.     category: 'Three-D-Graphics'!
  1863.  
  1864.  
  1865. !Parallelepiped methodsFor: 'accessing'!
  1866.  
  1867. depth
  1868.     "Answer with a ThreeDPoint representing the depth
  1869.      extent of the receiver."
  1870.  
  1871.     ^depth!
  1872.  
  1873. depth: aThreeDPoint
  1874.     "Set the depth extent of the receiver to be aThreeDPoint."
  1875.  
  1876.     depth _ aThreeDPoint!
  1877.  
  1878. farBottomLeft
  1879.     "Answer with aThreeDPoint representing the far bottom left corner
  1880.      of the receiver."
  1881.  
  1882.     ^vert - origin + depth!
  1883.  
  1884. farBottomRight
  1885.     "Answer with aThreeDPoint representing the far bottom right corner
  1886.      of the receiver."
  1887.  
  1888.     ^(vert - origin) + (horiz - origin) + depth!
  1889.  
  1890. farTopLeft
  1891.     "Answer with aThreeDPoint representing the far top left corner
  1892.      of the receiver."
  1893.  
  1894.     ^depth!
  1895.  
  1896. farTopRight
  1897.     "Answer with aThreeDPoint representing the far top right corner
  1898.      of the receiver."
  1899.  
  1900.     ^horiz - origin + depth!
  1901.  
  1902. horiz
  1903.     "Answer with a ThreeDPoint representing the horizontal
  1904.      extent of the receiver."
  1905.  
  1906.     ^horiz!
  1907.  
  1908. horiz: aThreeDPoint
  1909.     "Set the horizontal extent of the receiver to be aThreeDPoint."
  1910.  
  1911.     horiz _ aThreeDPoint!
  1912.  
  1913. nearBottomLeft
  1914.     "Answer with aThreeDPoint representing the near bottom left corner
  1915.      of the receiver."
  1916.  
  1917.     ^vert!
  1918.  
  1919. nearBottomRight
  1920.     "Answer with aThreeDPoint representing the near bottom right corner
  1921.      of the receiver."
  1922.  
  1923.     ^vert - origin + horiz!
  1924.  
  1925. nearTopLeft
  1926.     "Answer with aThreeDPoint representing the near top left corner
  1927.      of the receiver."
  1928.  
  1929.     ^origin!
  1930.  
  1931. nearTopRight
  1932.     "Answer with aThreeDPoint representing the near top right corner
  1933.      of the receiver."
  1934.  
  1935.     ^horiz!
  1936.  
  1937. origin
  1938.     "Answer with a ThreeDPoint representing the origin of the receiver."
  1939.  
  1940.     ^origin!
  1941.  
  1942. origin: aThreeDPoint
  1943.     "Set the origin of the receiver to be aThreeDPoint."
  1944.  
  1945.     origin _ aThreeDPoint!
  1946.  
  1947. origin: orig horiz: h vert: v depth: d
  1948.     "Set the receiver's origin horizontal, depth and vertical locations
  1949.      as given by the arguments."
  1950.  
  1951.     origin _ orig.
  1952.     vert _ v.
  1953.     horiz _ h.
  1954.     depth _ d!
  1955.  
  1956. origin: orig horizExtent: h vertExtent: v depthExtent: d
  1957.     "Set the receiver's origin horizontal, depth and vertical extents
  1958.      as given by the arguments."
  1959.  
  1960.     origin _ orig.
  1961.     vert _ v - orig.
  1962.     horiz _ h - orig.
  1963.     depth _ d - orig!
  1964.  
  1965. refPoint
  1966.     "Answer with a ThreeDPoint which is the 'reference point'
  1967.      used when the object is first added to a compound object.
  1968.      In this case, the reference point is the origin"
  1969.  
  1970.     ^origin!
  1971.  
  1972. vert
  1973.     "Answer with a ThreeDPoint representing the vertical
  1974.      extent of the receiver."
  1975.  
  1976.     ^vert!
  1977.  
  1978. vert: aThreeDPoint
  1979.     "Set the vertical extent of the receiver to be aThreeDPoint."
  1980.  
  1981.     vert _ aThreeDPoint!
  1982.  
  1983. vertices
  1984.     "Answer with an OrderedCollection of the vertices represented by
  1985.      the receiver."
  1986.  
  1987.     | collection |
  1988.     collection _ OrderedCollection new.
  1989.     collection add: self farBottomLeft.
  1990.     collection add: self farBottomRight.
  1991.     collection add: self farTopLeft.
  1992.     collection add: self farTopRight.
  1993.     collection add: self nearBottomLeft.
  1994.     collection add: self nearBottomRight.
  1995.     collection add: self nearTopLeft.
  1996.     collection add: self nearTopRight.
  1997.     ^collection! !
  1998.  
  1999. !Parallelepiped methodsFor: 'comparing'!
  2000.  
  2001. = aParallelepiped 
  2002.     "Answer true if the receiver's species, origin and corner match aParallelepiped's."
  2003.  
  2004.     self species = aParallelepiped species
  2005.         ifTrue: [^((origin = aParallelepiped origin
  2006.                     and: [vert = aParallelepiped vert])
  2007.                     and: [horiz = aParallelepiped horiz])
  2008.                     and: [depth = aParallelepiped depth]]
  2009.         ifFalse: [^false]!
  2010.  
  2011. hash
  2012.  
  2013.     ^(origin hash bitXor: vert hash) bitXor: (horiz hash bitXor: depth hash)! !
  2014.  
  2015. !Parallelepiped methodsFor: 'modifying'!
  2016.  
  2017. moveObject: vertex to: newPoint
  2018.     "Move the entire object so that vertex is at newPoint."
  2019.  
  2020.     | delta |
  2021.     delta _ newPoint - vertex.
  2022.     self horiz moveTo: horiz + delta.
  2023.     self vert moveTo: vert + delta.
  2024.     self depth moveTo: depth + delta.
  2025.     self origin moveTo: origin + delta.
  2026.     vertex moveTo: newPoint.
  2027.     self changed!
  2028.  
  2029. moveVertex: vertex to: newPoint
  2030.     "Move this vertex to newPoint.  Re-align the receiver appropriately."
  2031.  
  2032.     | delta opposite nearestVertices oppositeVertices |
  2033.     delta _ (newPoint - vertex) / 3.
  2034.     opposite _ self oppositeVertexTo: vertex.
  2035.     nearestVertices _ self nearestVerticesTo: vertex.
  2036.     oppositeVertices _ self nearestVerticesTo: opposite.
  2037.     nearestVertices do: [:eachVertex |
  2038.         eachVertex moveTo: eachVertex + (delta * 2)].
  2039.     oppositeVertices do: [:eachVertex |
  2040.         eachVertex moveTo: eachVertex + delta].
  2041.     vertex moveTo: newPoint.
  2042.     self changed! !
  2043.  
  2044. !Parallelepiped methodsFor: 'truncation and rounding'!
  2045.  
  2046. rounded
  2047.     "Answer with a new Parallelepiped whose origin, and horizontal
  2048.      and vertical sizes are truncated."
  2049.  
  2050.     ^Parallelepiped
  2051.         origin: origin truncated
  2052.         horiz: horiz truncated
  2053.         vert: vert truncated
  2054.         depth: depth truncated! !
  2055.  
  2056. !Parallelepiped methodsFor: 'converting'!
  2057.  
  2058. asLines
  2059.     "Answer with an OrderedCollection of lines representing the receiver."
  2060.  
  2061.     cachedLines isNil ifTrue: [
  2062.         cachedLines _ OrderedCollection new.
  2063.         cachedLines add:
  2064.             (ThreeDLine start: self nearTopLeft end: self nearTopRight).
  2065.         cachedLines add:
  2066.             (ThreeDLine start: self nearTopLeft end: self nearBottomLeft).
  2067.         cachedLines add:
  2068.             (ThreeDLine start: self nearTopRight end: self nearBottomRight).
  2069.         cachedLines add:
  2070.             (ThreeDLine start: self nearBottomLeft end: self nearBottomRight).
  2071.         cachedLines add:
  2072.             (ThreeDLine start: self farTopLeft end: self farTopRight).
  2073.         cachedLines add:
  2074.             (ThreeDLine start: self farTopLeft end: self farBottomLeft).
  2075.         cachedLines add:
  2076.             (ThreeDLine start: self farTopRight end: self farBottomRight).
  2077.         cachedLines add:
  2078.             (ThreeDLine start: self farBottomLeft end: self farBottomRight).
  2079.         cachedLines add:
  2080.             (ThreeDLine start: self nearTopLeft end: self farTopLeft).
  2081.         cachedLines add:
  2082.             (ThreeDLine start: self nearBottomLeft end: self farBottomLeft).
  2083.         cachedLines add:
  2084.             (ThreeDLine start: self nearTopRight end: self farTopRight).
  2085.         cachedLines add:
  2086.             (ThreeDLine start: self nearBottomRight end: self farBottomRight)].
  2087.     ^cachedLines!
  2088.  
  2089. asPlanes
  2090.     "Answer with an OrderedCollection of ThreeDPlanes representing
  2091.      the receiver."
  2092.  
  2093.     | collection |
  2094.     collection _ OrderedCollection new.
  2095.     collection add: (ThreeDPlane
  2096.                         with: self farTopLeft with: self farBottomLeft
  2097.                         with: self nearBottomLeft with: self nearTopLeft).
  2098.     collection add: (ThreeDPlane
  2099.                         with: self farTopLeft with: self farTopRight
  2100.                         with: self nearTopRight with: self nearTopLeft).
  2101.     collection add: (ThreeDPlane
  2102.                         with: self farTopRight with: self farBottomRight
  2103.                         with: self nearBottomRight with: self nearTopRight).
  2104.     collection add: (ThreeDPlane
  2105.                         with: self farBottomRight with: self farBottomLeft
  2106.                         with: self nearBottomLeft with: self nearBottomRight).
  2107.     collection add: (ThreeDPlane
  2108.                         with: self farBottomRight with: self farTopRight
  2109.                         with: self farTopLeft with: self farBottomLeft).
  2110.     collection add: (ThreeDPlane
  2111.                         with: self nearBottomRight with: self nearTopRight
  2112.                         with: self nearTopLeft with: self nearBottomLeft).
  2113.     ^collection! !
  2114.  
  2115. !Parallelepiped methodsFor: 'transforming'!
  2116.  
  2117. rotateBy: aRotation 
  2118.     "Answer a new Parallelepiped rotated by aRotation."
  2119.  
  2120.     ^Parallelepiped
  2121.         origin: (origin rotateBy: aRotation)
  2122.         horiz: (horiz rotateBy: aRotation)
  2123.         vert: (vert rotateBy: aRotation)
  2124.         depth: (depth rotateBy: aRotation)!
  2125.  
  2126. scaleBy: aThreeDPoint 
  2127.     "Answer a new Parallelepiped scaled by aThreeDPoint."
  2128.  
  2129.     ^Parallelepiped
  2130.         origin: (origin scaleBy: aThreeDPoint)
  2131.         horiz: (horiz scaleBy: aThreeDPoint)
  2132.         vert: (vert scaleBy: aThreeDPoint)
  2133.         depth: (depth scaleBy: aThreeDPoint)!
  2134.  
  2135. translateBy: aThreeDPoint 
  2136.     "Answer a new Parallelepiped translated by aThreeDPoint."
  2137.  
  2138.     ^Parallelepiped
  2139.         origin: (origin translateBy: aThreeDPoint)
  2140.         horiz: (horiz translateBy: aThreeDPoint)
  2141.         vert: (vert translateBy: aThreeDPoint)
  2142.         depth: (depth translateBy: aThreeDPoint)! !
  2143.  
  2144. !Parallelepiped methodsFor: 'private'!
  2145.  
  2146. nearestVerticesTo: vertex
  2147.     "Answer with an OrderedCollection containing the three vertices
  2148.      which are nearest to vertex."
  2149.  
  2150.     (vertex = self nearTopLeft) ifTrue: [
  2151.         ^OrderedCollection
  2152.             with: self nearTopRight
  2153.             with: self nearBottomLeft
  2154.             with: self farTopLeft].
  2155.     (vertex = self nearTopRight) ifTrue: [
  2156.         ^OrderedCollection
  2157.             with: self nearTopLeft
  2158.             with: self nearBottomRight
  2159.             with: self farTopRight].
  2160.     (vertex = self nearBottomLeft) ifTrue: [
  2161.         ^OrderedCollection
  2162.             with: self nearTopLeft
  2163.             with: self nearBottomRight
  2164.             with: self farBottomLeft].
  2165.     (vertex = self nearBottomRight) ifTrue: [
  2166.         ^OrderedCollection
  2167.             with: self nearTopRight
  2168.             with: self nearBottomLeft
  2169.             with: self farBottomRight].
  2170.     (vertex = self farTopLeft) ifTrue: [
  2171.         ^OrderedCollection
  2172.             with: self farTopRight
  2173.             with: self farBottomLeft
  2174.             with: self nearTopLeft].
  2175.     (vertex = self farTopRight) ifTrue: [
  2176.         ^OrderedCollection
  2177.             with: self farTopLeft
  2178.             with: self farBottomRight
  2179.             with: self nearTopRight].
  2180.     (vertex = self farBottomLeft) ifTrue: [
  2181.         ^OrderedCollection
  2182.             with: self farTopLeft
  2183.             with: self farBottomRight
  2184.             with: self nearBottomLeft].
  2185.     ^OrderedCollection
  2186.         with: self farTopRight
  2187.         with: self farBottomLeft
  2188.         with: self nearBottomRight!
  2189.  
  2190. oppositeVertexTo: vertex
  2191.     "Answer with the vertex directly opposite vertex."
  2192.  
  2193.     (vertex = self nearTopLeft) ifTrue: [^self farBottomRight].
  2194.     (vertex = self nearTopRight) ifTrue: [^self farBottomLeft].
  2195.     (vertex = self nearBottomLeft) ifTrue: [^self farTopRight].
  2196.     (vertex = self nearBottomRight) ifTrue: [^self farTopLeft].
  2197.     (vertex = self farTopLeft) ifTrue: [^self nearBottomRight].
  2198.     (vertex = self farTopRight) ifTrue: [^self nearBottomLeft].
  2199.     (vertex = self farBottomLeft) ifTrue: [^self nearTopRight].
  2200.     ^self nearTopLeft! !
  2201. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2202.  
  2203. Parallelepiped class
  2204.     instanceVariableNames: ''!
  2205.  
  2206.  
  2207. !Parallelepiped class methodsFor: 'instance creation'!
  2208.  
  2209. default
  2210.     "The default Parallelepiped is a cuboid of size 3 by 4 by 5, centered
  2211.      on the origin."
  2212.  
  2213.     ^self
  2214.         origin: (ThreeDPoint x: -1.5 y: -2.0 z: -2.5)
  2215.         horiz: (ThreeDPoint x: 1.5 y: -2.0 z: -2.5)
  2216.         vert: (ThreeDPoint x: -1.5 y: 2.0 z: -2.5)
  2217.         depth: (ThreeDPoint x: -1.5 y: -2.0 z: 2.5)!
  2218.  
  2219. origin: orig horiz: h vert: v depth: d
  2220.     "Answer with a new instance of me with origin, and horizontal
  2221.      and vertical sizes given by the arguments."
  2222.  
  2223.     ^self new origin: orig horiz: h vert: v depth: d!
  2224.  
  2225. origin: orig horizExtent: h vertExtent: v depthExtent: d
  2226.     "Answer with a new instance of me with origin, and horizontal
  2227.      and vertical extents given by the arguments."
  2228.  
  2229.     ^self new origin: orig horizExtent: h vertExtent: v depthExtent: d! !
  2230.  
  2231. Object subclass: #ThreeDTransformation
  2232.     instanceVariableNames: 'scale translation rotation '
  2233.     classVariableNames: ''
  2234.     poolDictionaries: ''
  2235.     category: 'Three-D-Graphics'!
  2236. ThreeDTransformation comment:
  2237. 'I represent the ability to perform transformations in 3-D space.  My
  2238. protocols are modelled on those of class WindowingTransformation.  My
  2239. instance variables are:
  2240. scale            <Number> or <ThreeDPoint> representing a
  2241.                 linear scaling factor.
  2242. translation        <Number> or <ThreeDPoint> representing a
  2243.                 translation in 3-D.
  2244. rotation        <Array> of 9 numbers representing a rotation
  2245.                 in 3-D space.
  2246. All 3-D objects are supposed to be able to be transformed using
  2247. instances of me.  Instances of me can also be combined to form a
  2248. single composite transformation.'!
  2249.  
  2250.  
  2251. !ThreeDTransformation methodsFor: 'accessing'!
  2252.  
  2253. rotation
  2254.     "Answer a copy of the current rotation."
  2255.  
  2256.     ^rotation copy!
  2257.  
  2258. scale
  2259.     "Answer a copy of the ThreeDPoint that represents the
  2260.      current scale of the receiver."
  2261.  
  2262.     scale == nil
  2263.         ifTrue: [^ThreeDPoint x: 1 y: 1 z: 1]
  2264.         ifFalse: [^scale copy]!
  2265.  
  2266. translation
  2267.     "Answer a copy of the receiver's translation."
  2268.  
  2269.     ^translation copy!
  2270.  
  2271. translation: aValue
  2272.     "Set the receiver's translation to aValue."
  2273.  
  2274.     translation _ aValue! !
  2275.  
  2276. !ThreeDTransformation methodsFor: 'testing'!
  2277.  
  2278. noScale
  2279.     "Answer true if the identity scale is in effect;  answer false, otherwise."
  2280.  
  2281.     ^scale == nil! !
  2282.  
  2283. !ThreeDTransformation methodsFor: 'applying transform'!
  2284.  
  2285. applyInverseTo: anObject 
  2286.     "Apply the inverse of the receiver to anObject and answer the result."
  2287.  
  2288.     | transformedObject |
  2289.     transformedObject _ anObject translateBy: self inverseTranslation.
  2290.     transformedObject _ transformedObject rotateBy: self inverseRotation.
  2291.     scale == nil ifFalse: [
  2292.         transformedObject _ transformedObject scaleBy: self inverseScale].
  2293.     ^transformedObject!
  2294.  
  2295. applyTo: anObject 
  2296.     "Apply the receiver to anObject and answer the result."
  2297.  
  2298.     | transformedObject |
  2299.     scale == nil
  2300.         ifTrue: [transformedObject _ anObject]
  2301.         ifFalse: [transformedObject _ anObject scaleBy: scale].
  2302.     transformedObject _ transformedObject rotateBy: rotation.
  2303.     transformedObject _ transformedObject translateBy: translation.
  2304.     ^transformedObject!
  2305.  
  2306. compose: aTransformation 
  2307.     "Answer a new ThreeDTransformation that is the
  2308.      composition of the receiver and aTransformation.
  2309.      The effect of applying the resulting ThreeDTransformation
  2310.      to an object is the same as that of first applying
  2311.      aTransformation to the object and then applying the 
  2312.      receiver to its result."
  2313.  
  2314.     | aTransformationScale newScale newTranslation rot newRotation |
  2315.     aTransformationScale _ aTransformation scale.
  2316.     scale == nil
  2317.         ifTrue: 
  2318.             [aTransformation noScale
  2319.                 ifTrue: [newScale _ nil]
  2320.                 ifFalse: [newScale _ aTransformationScale].
  2321.             newTranslation _ translation + aTransformation translation]
  2322.         ifFalse: 
  2323.             [aTransformation noScale
  2324.                 ifTrue: [newScale _ scale]
  2325.                 ifFalse: [newScale _ scale * aTransformationScale].
  2326.             newTranslation _ translation + (scale * aTransformation translation)].
  2327.     rot _ aTransformation rotation.
  2328.     newRotation _ Array new: 9.
  2329.     newRotation at: 1 put:    ((rot at: 1) * (rotation at: 1)) +
  2330.         ((rot at: 2) * (rotation at: 4)) + ((rot at: 3) * (rotation at: 7)).
  2331.     newRotation at: 2 put: ((rot at: 1) * (rotation at: 2)) +
  2332.         ((rot at: 2) * (rotation at: 5)) + ((rot at: 3) * (rotation at: 8)).
  2333.     newRotation at: 3 put: ((rot at: 1) * (rotation at: 3)) +
  2334.         ((rot at: 2) * (rotation at: 6)) + ((rot at: 3) * (rotation at: 9)).
  2335.  
  2336.     newRotation at: 4 put:    ((rot at: 4) * (rotation at: 1)) +
  2337.         ((rot at: 5) * (rotation at: 4)) + ((rot at: 6) * (rotation at: 7)).
  2338.     newRotation at: 5 put: ((rot at: 4) * (rotation at: 2)) +
  2339.         ((rot at: 5) * (rotation at: 5)) + ((rot at: 6) * (rotation at: 8)).
  2340.     newRotation at: 6 put: ((rot at: 4) * (rotation at: 3)) +
  2341.         ((rot at: 5) * (rotation at: 6)) + ((rot at: 6) * (rotation at: 9)).
  2342.  
  2343.     newRotation at: 7 put:    ((rot at: 7) * (rotation at: 1)) +
  2344.         ((rot at: 8) * (rotation at: 4)) + ((rot at: 9) * (rotation at: 7)).
  2345.     newRotation at: 8 put: ((rot at: 7) * (rotation at: 2)) +
  2346.         ((rot at: 8) * (rotation at: 5)) + ((rot at: 9) * (rotation at: 8)).
  2347.     newRotation at: 9 put: ((rot at: 7) * (rotation at: 3)) +
  2348.         ((rot at: 8) * (rotation at: 6)) + ((rot at: 9) * (rotation at: 9)).
  2349.  
  2350.     ^ThreeDTransformation
  2351.         scale: newScale
  2352.         translation: newTranslation
  2353.         rotation: newRotation! !
  2354.  
  2355. !ThreeDTransformation methodsFor: 'transforming'!
  2356.  
  2357. rotateBy: rot
  2358.     "Answer with a new ThreeDTransformation rotated by rot."
  2359.  
  2360.     | newRotation |
  2361.     newRotation _ Array new: 9.
  2362.     newRotation at: 1 put:    ((rot at: 1) * (rotation at: 1)) +
  2363.         ((rot at: 2) * (rotation at: 4)) + ((rot at: 3) * (rotation at: 7)).
  2364.     newRotation at: 2 put: ((rot at: 1) * (rotation at: 2)) +
  2365.         ((rot at: 2) * (rotation at: 5)) + ((rot at: 3) * (rotation at: 8)).
  2366.     newRotation at: 3 put: ((rot at: 1) * (rotation at: 3)) +
  2367.         ((rot at: 2) * (rotation at: 6)) + ((rot at: 3) * (rotation at: 9)).
  2368.  
  2369.     newRotation at: 4 put:    ((rot at: 4) * (rotation at: 1)) +
  2370.         ((rot at: 5) * (rotation at: 4)) + ((rot at: 6) * (rotation at: 7)).
  2371.     newRotation at: 5 put: ((rot at: 4) * (rotation at: 2)) +
  2372.         ((rot at: 5) * (rotation at: 5)) + ((rot at: 6) * (rotation at: 8)).
  2373.     newRotation at: 6 put: ((rot at: 4) * (rotation at: 3)) +
  2374.         ((rot at: 5) * (rotation at: 6)) + ((rot at: 6) * (rotation at: 9)).
  2375.  
  2376.     newRotation at: 7 put:    ((rot at: 7) * (rotation at: 1)) +
  2377.         ((rot at: 8) * (rotation at: 4)) + ((rot at: 9) * (rotation at: 7)).
  2378.     newRotation at: 8 put: ((rot at: 7) * (rotation at: 2)) +
  2379.         ((rot at: 8) * (rotation at: 5)) + ((rot at: 9) * (rotation at: 8)).
  2380.     newRotation at: 9 put: ((rot at: 7) * (rotation at: 3)) +
  2381.         ((rot at: 8) * (rotation at: 6)) + ((rot at: 9) * (rotation at: 9)).
  2382.  
  2383.     ^ThreeDTransformation scale: scale translation: translation rotation: newRotation!
  2384.  
  2385. rotateXBy: anAngle
  2386.     "Answer with a new ThreeDTransformation rotated about
  2387.      the x-axis by anAngle."
  2388.  
  2389.     | angleCos angleSin newRotation |
  2390.     newRotation _ rotation deepCopy.
  2391.     angleCos _ anAngle degreesToRadians cos.
  2392.     angleSin _ anAngle degreesToRadians sin.
  2393.     newRotation at: 4 put: ((rotation at: 4) * angleCos) + ((rotation at: 7) * angleSin).
  2394.     newRotation at: 5 put: ((rotation at: 5) * angleCos) + ((rotation at: 8) * angleSin).
  2395.     newRotation at: 6 put: ((rotation at: 6) * angleCos) + ((rotation at: 9) * angleSin).
  2396.     angleSin _ 0 - angleSin.
  2397.     newRotation at: 7 put: ((rotation at: 4) * angleSin) + ((rotation at: 7) * angleCos).
  2398.     newRotation at: 8 put: ((rotation at: 5) * angleSin) + ((rotation at: 8) * angleCos).
  2399.     newRotation at: 9 put: ((rotation at: 6) * angleSin) + ((rotation at: 9) * angleCos).
  2400.     ^ThreeDTransformation
  2401.         scale: scale
  2402.         translation: translation
  2403.         rotation: newRotation!
  2404.  
  2405. rotateYBy: anAngle
  2406.     "Answer with a new ThreeDTransformation rotated about
  2407.      the y-axis by anAngle."
  2408.  
  2409.     | angleCos angleSin newRotation |
  2410.     newRotation _ rotation deepCopy.
  2411.     angleCos _ anAngle degreesToRadians cos.
  2412.     angleSin _ 0 - (anAngle degreesToRadians sin).
  2413.     newRotation at: 1 put: ((rotation at: 1) * angleCos) + ((rotation at: 7) * angleSin).
  2414.     newRotation at: 2 put: ((rotation at: 2) * angleCos) + ((rotation at: 8) * angleSin).
  2415.     newRotation at: 3 put: ((rotation at: 3) * angleCos) + ((rotation at: 9) * angleSin).
  2416.     angleSin _ 0 - angleSin.
  2417.     newRotation at: 7 put: ((rotation at: 1) * angleSin) + ((rotation at: 7) * angleCos).
  2418.     newRotation at: 8 put: ((rotation at: 2) * angleSin) + ((rotation at: 8) * angleCos).
  2419.     newRotation at: 9 put: ((rotation at: 3) * angleSin) + ((rotation at: 9) * angleCos).
  2420.     ^ThreeDTransformation
  2421.         scale: scale
  2422.         translation: translation
  2423.         rotation: newRotation!
  2424.  
  2425. rotateZBy: anAngle
  2426.     "Answer with a new ThreeDTransformation rotated about
  2427.      the z-axis by anAngle."
  2428.  
  2429.     | angleCos angleSin newRotation |
  2430.     newRotation _ rotation deepCopy.
  2431.     angleCos _ anAngle degreesToRadians cos.
  2432.     angleSin _ anAngle degreesToRadians sin.
  2433.     newRotation at: 1 put: ((rotation at: 1) * angleCos) + ((rotation at: 4) * angleSin).
  2434.     newRotation at: 2 put: ((rotation at: 2) * angleCos) + ((rotation at: 5) * angleSin).
  2435.     newRotation at: 3 put: ((rotation at: 3) * angleCos) + ((rotation at: 6) * angleSin).
  2436.     angleSin _ 0 - angleSin.
  2437.     newRotation at: 4 put: ((rotation at: 1) * angleSin) + ((rotation at: 4) * angleCos).
  2438.     newRotation at: 5 put: ((rotation at: 2) * angleSin) + ((rotation at: 5) * angleCos).
  2439.     newRotation at: 6 put: ((rotation at: 3) * angleSin) + ((rotation at: 6) * angleCos).
  2440.     ^ThreeDTransformation
  2441.         scale: scale
  2442.         translation: translation
  2443.         rotation: newRotation!
  2444.  
  2445. scaleBy: aScale 
  2446.     "Answer a new ThreeDTransformation with the scale and translation of 
  2447.      the receiver both scaled by aScale.  Rotations are unaffected."
  2448.  
  2449.     | checkedScale newScale newTranslation |
  2450.     aScale == nil
  2451.         ifTrue: 
  2452.             [newScale _ scale.
  2453.             newTranslation _ translation]
  2454.         ifFalse: 
  2455.             [checkedScale _ self checkScale: aScale.
  2456.             scale == nil
  2457.                 ifTrue: [newScale _ checkedScale]
  2458.                 ifFalse: [newScale _ scale * checkedScale].
  2459.             newTranslation _ checkedScale * translation].
  2460.     ^ThreeDTransformation
  2461.         scale: newScale
  2462.         translation: newTranslation
  2463.         rotation: rotation!
  2464.  
  2465. translateBy: aThreeDPoint 
  2466.     "Answer a new ThreeDTransformation with the same scale and 
  2467.      rotations as the receiver and with a translation of the current 
  2468.      translation plus aThreeDPoint."
  2469.  
  2470.     ^ThreeDTransformation
  2471.         scale: scale
  2472.         translation: translation + aThreeDPoint
  2473.         rotation: rotation! !
  2474.  
  2475. !ThreeDTransformation methodsFor: 'printing'!
  2476.  
  2477. printOn: aStream
  2478.     aStream nextPutAll: self class name, ' scale: '.
  2479.     scale printOn: aStream.
  2480.     aStream nextPutAll: ' translation: '.
  2481.     translation printOn: aStream.
  2482.     aStream nextPutAll: ' rotation: '.
  2483.     rotation printOn: aStream! !
  2484.  
  2485. !ThreeDTransformation methodsFor: 'private'!
  2486.  
  2487. checkScale: aScale
  2488.     "Converts aScale to the internal format of a floating-point ThreeDPoint."
  2489.  
  2490.      | checkedScale |
  2491.     checkedScale _ aScale asThreeDPoint.
  2492.     ^ThreeDPoint
  2493.         x: checkedScale x asFloat
  2494.         y: checkedScale y asFloat
  2495.         z: checkedScale x asFloat!
  2496.  
  2497. inverseRotation
  2498.     "Answer with an Array representing the inverse of my rotation."
  2499.  
  2500.     | invRotation |
  2501.     invRotation _ Array new: 9.
  2502.     invRotation at: 1 put: (rotation at: 1).
  2503.     invRotation at: 2 put: (rotation at: 4).
  2504.     invRotation at: 3 put: (rotation at: 7).
  2505.     invRotation at: 4 put: (rotation at: 2).
  2506.     invRotation at: 5 put: (rotation at: 5).
  2507.     invRotation at: 6 put: (rotation at: 8).
  2508.     invRotation at: 7 put: (rotation at: 3).
  2509.     invRotation at: 8 put: (rotation at: 6).
  2510.     invRotation at: 9 put: (rotation at: 9).
  2511.     ^invRotation!
  2512.  
  2513. inverseScale
  2514.     "Answer with a ThreeDPoint representing the inverse of my
  2515.      scale."
  2516.  
  2517.     | newScale |
  2518.     newScale _ self checkScale: scale.
  2519.     ^ThreeDPoint
  2520.         x: (1.0 / newScale x)
  2521.         y: (1.0 / newScale y)
  2522.         z: (1.0 / newScale z)!
  2523.  
  2524. inverseTranslation
  2525.     "Answer with a ThreeDPoint representing the inverse of my
  2526.      translation."
  2527.  
  2528.     | trans |
  2529.     trans _ translation asThreeDPoint.
  2530.     ^ThreeDPoint
  2531.         x: trans x negated
  2532.         y: trans y negated
  2533.         z: trans z negated!
  2534.  
  2535. setScale: aScale translation: aTranslation rotation: aRotation
  2536.     "Sets the scale to aScale and the translation to aTranslation.  Sets
  2537.      the x,y and z rotations to aRotation."
  2538.  
  2539.     scale _ aScale.
  2540.     translation _ aTranslation.
  2541.     rotation _ aRotation! !
  2542. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2543.  
  2544. ThreeDTransformation class
  2545.     instanceVariableNames: ''!
  2546.  
  2547.  
  2548. !ThreeDTransformation class methodsFor: 'instance creation'!
  2549.  
  2550. identity
  2551.     "Answer an instance of me with no scaling (nil) and no translation 
  2552.      (0@0@0).  All rotations are zero."
  2553.  
  2554.      ^self new
  2555.         setScale: nil
  2556.         translation: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  2557.         rotation: #(1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)!
  2558.  
  2559. rotation: aRotation
  2560.     "Answer an instance of me with a scale factor of  
  2561.      nil and a translation offset of (0@0@0).  Rotations 
  2562.      about the x, y and z axes are given by aRotation."
  2563.  
  2564.     ^self new
  2565.         setScale: nil
  2566.         translation: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  2567.         rotation: aRotation!
  2568.  
  2569. scale: aScale translation: aTranslation 
  2570.     "Answer an instance of me with a scale factor of  
  2571.      aScale and a translation offset of aTranslation.  All 
  2572.      rotations are 0."
  2573.  
  2574.     ^self new
  2575.         setScale: aScale
  2576.         translation: aTranslation
  2577.         rotation: #(1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)!
  2578.  
  2579. scale: aScale translation: aTranslation rotation: aRotation
  2580.     "Answer an instance of me with a scale factor of  
  2581.      aScale and a translation offset of aTranslation.  Rotations 
  2582.      about the x,y and z axes are given by aRotation."
  2583.  
  2584.     ^self new
  2585.         setScale: aScale
  2586.         translation: aTranslation
  2587.         rotation: aRotation! !
  2588.  
  2589. ThreeDObject subclass: #ThreeDPlane
  2590.     instanceVariableNames: 'vertices nearest furthest leftmost rightmost highest lowest '
  2591.     classVariableNames: ''
  2592.     poolDictionaries: ''
  2593.     category: 'Three-D-Graphics'!
  2594. ThreeDPlane comment:
  2595. 'I represent a plane in 3-D.  My instance variables are:
  2596.  
  2597. vertices    <OrderedCollection> of ThreeDPoints, representing the edges
  2598.             of the plane.
  2599. nearest        <ThreeDPoint> representing the nearest point (i.e with the
  2600.             smallest z coordinate).
  2601. furthest    <ThreeDPoint> representing the furthest point.
  2602. leftmost    <ThreeDPoint> representing the point furthest to the left (i.e with
  2603.             the smallest x coordinate).
  2604. rightmost    <ThreeDPoint> furthest to right.
  2605. highest        <ThreeDPoint> representing uppermost point (i.e smallest y coordinate).
  2606. lowest        <ThreeDPoint> furthest down.
  2607.  
  2608. The last six instance variables are used as cached versions, and are
  2609. calculated as required.'!
  2610.  
  2611.  
  2612. !ThreeDPlane methodsFor: 'initialize-release'!
  2613.  
  2614. initialize
  2615.  
  2616.     vertices _ OrderedCollection new.! !
  2617.  
  2618. !ThreeDPlane methodsFor: 'accessing'!
  2619.  
  2620. furthestVertex
  2621.     "Answer with the vertex with the largest z coordinate."
  2622.  
  2623.     furthest == nil ifTrue: [^self computeFurthest] ifFalse: [^furthest]!
  2624.  
  2625. highestVertex
  2626.     "Answer with the vertex with the smallest y coordinate."
  2627.  
  2628.     highest == nil ifTrue: [^self computeHighest] ifFalse: [^highest]!
  2629.  
  2630. leftmostVertex
  2631.     "Answer with the vertex with the smallest x coordinate."
  2632.  
  2633.     leftmost == nil ifTrue: [^self computeLeftmost] ifFalse: [^leftmost]!
  2634.  
  2635. lowestVertex
  2636.     "Answer with the vertex with the largest y coordinate."
  2637.  
  2638.     lowest == nil ifTrue: [^self computeLowest] ifFalse: [^lowest]!
  2639.  
  2640. nearestVertex
  2641.     "Answer with the vertex with the smallest z coordinate."
  2642.  
  2643.     nearest == nil ifTrue: [^self computeNearest] ifFalse: [^nearest]!
  2644.  
  2645. refPoint
  2646.     "Answer with a ThreeDPoint which is the 'reference point'
  2647.      used when the object is first added to a compound object.
  2648.      In this case, it is the point nearest to the observer."
  2649.  
  2650.     ^self nearestVertex!
  2651.  
  2652. rightmostVertex
  2653.     "Answer with the vertex with the largest x coordinate."
  2654.  
  2655.     rightmost == nil ifTrue: [^self computeRightmost] ifFalse: [^rightmost]!
  2656.  
  2657. vertices
  2658.     "Answer with an OrderedCollection of Points representing the receiver."
  2659.  
  2660.     ^vertices!
  2661.  
  2662. vertices: aCollection
  2663.     "Answer with an OrderedCollection of Points representing the receiver."
  2664.  
  2665.     vertices _ aCollection asOrderedCollection! !
  2666.  
  2667. !ThreeDPlane methodsFor: 'comparing'!
  2668.  
  2669. = aThreeDPlane
  2670.     "Answer whether the receiver and aThreeDPlane are equal."
  2671.  
  2672.     self species = aThreeDPlane species
  2673.         ifTrue: [^vertices = aThreeDPlane vertices]
  2674.         ifFalse: [^false]! !
  2675.  
  2676. !ThreeDPlane methodsFor: 'testing'!
  2677.  
  2678. xOverlap: aThreeDPlane
  2679.     "Answer true if the x-extent of the receiver overlaps that
  2680.      of aThreeDPlane, otherwise answer false."
  2681.  
  2682.     ^(self leftmostVertex x <= aThreeDPlane leftmostVertex x
  2683.         and: [self rightmostVertex x >= aThreeDPlane leftmostVertex x])
  2684.        or: [self leftmostVertex x <= aThreeDPlane rightmostVertex x
  2685.         and: [self rightmostVertex x >= aThreeDPlane rightmostVertex x]]!
  2686.  
  2687. yOverlap: aThreeDPlane
  2688.     "Answer true if the y-extent of the receiver overlaps that
  2689.      of aThreeDPlane, otherwise answer false."
  2690.  
  2691.     ^(self highestVertex y <= aThreeDPlane highestVertex y
  2692.         and: [self lowestVertex y >= aThreeDPlane highestVertex y])
  2693.        or: [self highestVertex y <= aThreeDPlane lowestVertex y
  2694.         and: [self lowestVertex y >= aThreeDPlane lowestVertex y]]!
  2695.  
  2696. zOverlap: aThreeDPlane
  2697.     "Answer true if the z-extent of the receiver overlaps that
  2698.      of aThreeDPlane, otherwise answer false."
  2699.  
  2700.     ^(self nearestVertex z <= aThreeDPlane nearestVertex z
  2701.         and: [self furthestVertex z >= aThreeDPlane nearestVertex z])
  2702.        or: [self nearestVertex z <= aThreeDPlane furthestVertex z
  2703.         and: [self furthestVertex z >= aThreeDPlane furthestVertex z]]! !
  2704.  
  2705. !ThreeDPlane methodsFor: 'modifying'!
  2706.  
  2707. moveObject: vertex to: newPoint
  2708.     "Move the entire object so that vertex is at newPoint."
  2709.  
  2710.     | delta |
  2711.     delta _ newPoint - vertex.
  2712.     self vertices: (self vertices collect: [:each |
  2713.         each moveTo: each + delta]).
  2714.     self changed!
  2715.  
  2716. moveVertex: vertex to: newPoint
  2717.     "Move this vertex to newPoint."
  2718.  
  2719.     self vertices: (self vertices collect: [:each |
  2720.         each == vertex ifTrue: [each moveTo: newPoint] ifFalse: [each]]).
  2721.     self changed! !
  2722.  
  2723. !ThreeDPlane methodsFor: 'truncation and rounding'!
  2724.  
  2725. rounded
  2726.     "Answer with a new ThreeDPlane with all the vertices rounded."
  2727.  
  2728.     ^ThreeDPlane vertices: (self vertices collect: [:each | each rounded])!
  2729.  
  2730. truncated
  2731.     "Answer with a new ThreeDPlane with all the vertices truncated."
  2732.  
  2733.     ^ThreeDPlane vertices: (self vertices collect: [:each | each truncated])! !
  2734.  
  2735. !ThreeDPlane methodsFor: 'converting'!
  2736.  
  2737. asLines
  2738.     "Answer with an OrderedCollection containing the lines representing the
  2739.      edges of the receiver."
  2740.  
  2741.     | array |
  2742.     cachedLines isNil ifTrue: [
  2743.         cachedLines _ OrderedCollection new.
  2744.         array _ vertices asArray.
  2745.         1 to: (array size - 1) do: [:each |
  2746.             cachedLines add: (ThreeDLine
  2747.                                 start: (array at: each)
  2748.                                 end: (array at: each + 1))].
  2749.         cachedLines add: (ThreeDLine start: array last end: array first)].
  2750.     ^cachedLines!
  2751.  
  2752. asPlanes
  2753.     "Answer with an OrderedCollection containing the receiver.  This
  2754.      method is included for compatibility."
  2755.  
  2756.     ^OrderedCollection with: self! !
  2757.  
  2758. !ThreeDPlane methodsFor: 'transforming'!
  2759.  
  2760. rotateBy: aRotation
  2761.     "Answer with a new ThreeDPlane rotated by aRotation."
  2762.  
  2763.     ^ThreeDPlane vertices: (vertices collect: [:each |
  2764.         each rotateBy: aRotation])!
  2765.  
  2766. scaleBy: aThreeDPoint
  2767.     "Answer with a new ThreeDPlane scaled by aThreeDPoint."
  2768.  
  2769.     ^ThreeDPlane vertices: (vertices collect: [:each |
  2770.         each scaleBy: aThreeDPoint])!
  2771.  
  2772. translateBy: aThreeDPoint
  2773.     "Answer with a new ThreeDPlane translated by aThreeDPoint."
  2774.  
  2775.     ^ThreeDPlane vertices: (vertices collect: [:each |
  2776.         each translateBy: aThreeDPoint])! !
  2777.  
  2778. !ThreeDPlane methodsFor: 'printing'!
  2779.  
  2780. printOn: aStream
  2781.  
  2782.     vertices printOn: aStream! !
  2783.  
  2784. !ThreeDPlane methodsFor: 'private'!
  2785.  
  2786. computeFurthest
  2787.     "Compute the vertex with the largest z value."
  2788.  
  2789.     furthest _ vertices first.
  2790.     vertices do: [:eachVertex |
  2791.         eachVertex z > furthest z ifTrue: [
  2792.             furthest _ eachVertex]].
  2793.     ^furthest!
  2794.  
  2795. computeHighest
  2796.     "Compute the vertex with the smallest y value."
  2797.  
  2798.     highest _ vertices first.
  2799.     vertices do: [:eachVertex |
  2800.         eachVertex y < highest y ifTrue: [
  2801.             highest _ eachVertex]].
  2802.     ^highest!
  2803.  
  2804. computeLeftmost
  2805.     "Compute the vertex with the smallest x value."
  2806.  
  2807.     leftmost _ vertices first.
  2808.     vertices do: [:eachVertex |
  2809.         eachVertex x < leftmost x ifTrue: [
  2810.             leftmost _ eachVertex]].
  2811.     ^leftmost!
  2812.  
  2813. computeLowest
  2814.     "Compute the vertex with the largest y value."
  2815.  
  2816.     lowest _ vertices first.
  2817.     vertices do: [:eachVertex |
  2818.         eachVertex y > lowest y ifTrue: [
  2819.             lowest _ eachVertex]].
  2820.     ^lowest!
  2821.  
  2822. computeNearest
  2823.     "Compute the vertex with the smallest z value."
  2824.  
  2825.     nearest _ vertices first.
  2826.     vertices do: [:eachVertex |
  2827.         eachVertex z < nearest z ifTrue: [
  2828.             nearest _ eachVertex]].
  2829.     ^nearest!
  2830.  
  2831. computeRightmost
  2832.     "Compute the vertex with the largest x value."
  2833.  
  2834.     rightmost _ vertices first.
  2835.     vertices do: [:eachVertex |
  2836.         eachVertex x > rightmost x ifTrue: [
  2837.             rightmost _ eachVertex]].
  2838.     ^rightmost! !
  2839. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2840.  
  2841. ThreeDPlane class
  2842.     instanceVariableNames: ''!
  2843.  
  2844.  
  2845. !ThreeDPlane class methodsFor: 'instance creation'!
  2846.  
  2847. vertices: aCollection
  2848.     "Create a new ThreeDPlane with the contents of aCollection."
  2849.  
  2850.     ^self new vertices: (OrderedCollection new addAll: aCollection)!
  2851.  
  2852. with: firstPoint with: secondPoint
  2853.     "Answer with a new ThreeDPlane described by firstPoint and secondPoint."
  2854.  
  2855.     ^self new vertices: (OrderedCollection with: firstPoint with: secondPoint)!
  2856.  
  2857. with: firstPoint with: secondPoint with: thirdPoint 
  2858.     "Answer with a new ThreeDPlane described by firstPoint, secondPoint 
  2859.      and thirdPoint."
  2860.  
  2861.     ^self new vertices:
  2862.         (OrderedCollection
  2863.             with: firstPoint
  2864.             with: secondPoint
  2865.             with: thirdPoint)!
  2866.  
  2867. with: firstPoint with: secondPoint with: thirdPoint with: fourthPoint
  2868.     "Answer with a new ThreeDPlane described by firstPoint, secondPoint 
  2869.      thirdPoint and fourthPoint."
  2870.  
  2871.     ^self new vertices:
  2872.         (OrderedCollection
  2873.             with: firstPoint
  2874.             with: secondPoint
  2875.             with: thirdPoint
  2876.             with: fourthPoint)! !
  2877.  
  2878. ThreeDObject subclass: #ThreeDModel
  2879.     instanceVariableNames: 'objects '
  2880.     classVariableNames: ''
  2881.     poolDictionaries: ''
  2882.     category: 'Three-D-Graphics'!
  2883. ThreeDModel comment:
  2884. 'I represent a collection of ThreeDObjects building up a scene.  The
  2885. instance variable objects is an OrderedCollection of ThreeDObjects.'!
  2886.  
  2887.  
  2888. !ThreeDModel methodsFor: 'initialize-release'!
  2889.  
  2890. initialize
  2891.     "Initialize the instance variable."
  2892.  
  2893.     objects _ OrderedCollection new.!
  2894.  
  2895. release
  2896.     "Send release to every object that I represent."
  2897.  
  2898.     objects notNil ifTrue: [
  2899.         objects do: [:eachObject | eachObject release]]! !
  2900.  
  2901. !ThreeDModel methodsFor: 'accessing'!
  2902.  
  2903. objects
  2904.     "Answer with the OrderedCollection of ThreeDObjects
  2905.      representing the receiver."
  2906.  
  2907.     ^objects!
  2908.  
  2909. objects: aCollection
  2910.     "Set the OrderedCollection of ThreeDObjects
  2911.      representing the receiver to aCollection."
  2912.  
  2913.     objects _ aCollection!
  2914.  
  2915. refPoint
  2916.     "Answer with a ThreeDPoint which is the 'reference point'
  2917.      used when the object is first added to a compound object.
  2918.      In this case, the reference point used is the reference point
  2919.      of the first object in the receiver."
  2920.  
  2921.     (objects size = 0)
  2922.         ifTrue: [^ThreeDPoint x: 0.0 y: 0.0 z: 0.0]
  2923.         ifFalse: [^objects first refPoint]!
  2924.  
  2925. vertices
  2926.     "Answer with an OrderedCollection of vertices representing all the
  2927.      ThreeDObjects in the receiver."
  2928.  
  2929.     | collection |
  2930.     collection _ OrderedCollection new.
  2931.         objects do: [:eachObject | collection addAll: eachObject vertices].
  2932.     ^collection! !
  2933.  
  2934. !ThreeDModel methodsFor: 'comparing'!
  2935.  
  2936. = aThreeDModel
  2937.     "Answer true if the receiver's species, apex and base match aThreeDModel's."
  2938.  
  2939.     self species = aThreeDModel species
  2940.         ifTrue: [^objects = aThreeDModel objects]
  2941.         ifFalse: [^false]!
  2942.  
  2943. hash
  2944.  
  2945.     ^objects hash!
  2946.  
  2947. hashMappedBy: map
  2948.     "Answer what my hash would be if oops changed according to map"
  2949.     ^ map newHashFor: self hash! !
  2950.  
  2951. !ThreeDModel methodsFor: 'modifying'!
  2952.  
  2953. addObject: anObject
  2954.     "Add anObject to the collection of objects representing the receiver."
  2955.  
  2956.     self objects add: anObject.
  2957.     anObject addDependent: self.
  2958.     cachedLines _ nil.    "Model has changed."!
  2959.  
  2960. moveObject: vertex to: newPoint
  2961.     "Move the entire object including vertex so that it is at newPoint."
  2962.  
  2963.     | object |
  2964.     object _ objects detect: [:eachObject |
  2965.         eachObject includesVertex: vertex] ifNone: [^nil].
  2966.     cachedLines _ nil.        "Model has changed."
  2967.     object moveObject: vertex to: newPoint.!
  2968.  
  2969. moveVertex: vertex to: newPoint
  2970.     "Identify the object containing vertex.  Move the vertex to newPoint."
  2971.  
  2972.     | object |
  2973.     object _ objects detect: [:eachObject |
  2974.         eachObject includesVertex: vertex] ifNone: [^nil].
  2975.     cachedLines _ nil.        "Model has changed."
  2976.     object moveVertex: vertex to: newPoint!
  2977.  
  2978. removeObject: vertex
  2979.     "Remove the entire object containing vertex."
  2980.  
  2981.     | object |
  2982.     object _ objects detect: [:eachObject |
  2983.         eachObject includesVertex: vertex] ifNone: [^nil].
  2984.     objects remove: object.
  2985.     object removeDependent: self.
  2986.     self changed!
  2987.  
  2988. update: aParameter
  2989.  
  2990.     self changed: aParameter! !
  2991.  
  2992. !ThreeDModel methodsFor: 'truncation and rounding'!
  2993.  
  2994. rounded
  2995.     "Answer with a ThreeDModel which all of the objects rounded."
  2996.  
  2997.     ^ThreeDModel objects: (objects collect: [:eachObject | eachObject rounded])!
  2998.  
  2999. truncated
  3000.     "Answer with a ThreeDModel which all of the objects truncated."
  3001.  
  3002.     ^ThreeDModel objects: (objects collect: [:eachObject | eachObject truncated])! !
  3003.  
  3004. !ThreeDModel methodsFor: 'converting'!
  3005.  
  3006. asLines
  3007.     "Answer with an OrderedCollection of ThreeDLines representing all
  3008.      of the ThreeDObjects in the receiver."
  3009.  
  3010.     cachedLines _ OrderedCollection new.
  3011.     objects do: [:eachObject | cachedLines addAll: eachObject asLines].
  3012.     ^cachedLines!
  3013.  
  3014. asPlanes
  3015.     "Answer with an OrderedCollection of ThreeDPlanes representing all
  3016.      of the ThreeDObjects in the receiver."
  3017.  
  3018.     | collection |
  3019.     collection _ OrderedCollection new.
  3020.     objects do: [:eachObject | collection addAll: eachObject asPlanes].
  3021.     ^collection! !
  3022. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3023.  
  3024. ThreeDModel class
  3025.     instanceVariableNames: ''!
  3026.  
  3027.  
  3028. !ThreeDModel class methodsFor: 'instance creation'!
  3029.  
  3030. default
  3031.     "The default ThreeDModel has no objects in it."
  3032.  
  3033.     ^self new!
  3034.  
  3035. new
  3036.     "Create an initialized instance of the receiver."
  3037.  
  3038.     ^super new initialize!
  3039.  
  3040. objects: aCollection
  3041.     "Create a new instance of me containing the objects in aCollection."
  3042.  
  3043.     | newModel |
  3044.     newModel _ self new.
  3045.     aCollection do: [:eachObject |
  3046.         newModel addObject: eachObject].
  3047.     ^newModel!
  3048.  
  3049. with: anObject
  3050.     "Answer with a new instance of the receiver containing anObject."
  3051.  
  3052.     ^self objects: (OrderedCollection with: anObject)!
  3053.  
  3054. with: firstObject with: secondObject
  3055.     "Answer with a new instance of the receiver containing firstObject
  3056.      and secondObject."
  3057.  
  3058.     ^self objects: (OrderedCollection with: firstObject with: secondObject)!
  3059.  
  3060. with: firstObject with: secondObject with: thirdObject 
  3061.     "Answer with a new instance of the receiver containing firstObject, 
  3062.      secondObject and thirdObject."
  3063.  
  3064.     ^self objects:
  3065.         (OrderedCollection
  3066.             with: firstObject
  3067.             with: secondObject
  3068.             with: thirdObject)! !
  3069.  
  3070. MouseMenuController subclass: #ThreeDController
  3071.     instanceVariableNames: 'redButtonFunction '
  3072.     classVariableNames: 'DefaultRedButtonFunction ThreeDYellowButtonMenu ThreeDYellowButtonMessages '
  3073.     poolDictionaries: ''
  3074.     category: 'Three-D-Views'!
  3075.  
  3076.  
  3077. !ThreeDController methodsFor: 'initialize-release'!
  3078.  
  3079. initialize
  3080.     "Initialize the yellow button menus and the red button operation."
  3081.  
  3082.     super initialize.
  3083.     self
  3084.         yellowButtonMenu: ThreeDYellowButtonMenu
  3085.         yellowButtonMessages: ThreeDYellowButtonMessages.
  3086.  
  3087.     redButtonFunction _ DefaultRedButtonFunction.! !
  3088.  
  3089. !ThreeDController methodsFor: 'menu messages'!
  3090.  
  3091. addLine
  3092.     "Set the current red button operation to be add line."
  3093.  
  3094.     redButtonFunction _ #addLine!
  3095.  
  3096. addObject
  3097.     "Prompt the user for the name of a new object.  Add it to the model's
  3098.      collection of objects."
  3099.  
  3100.     | aName aSymbol newObject newPoint |
  3101.     aName _ FillInTheBlank
  3102.                 request: 'Name of Three-D Object?'
  3103.                 initialAnswer: 'Cone'.
  3104.     aName isEmpty ifTrue: [^nil].
  3105.     aSymbol _ Smalltalk at: aName asSymbol ifAbsent: [
  3106.         ^self error: aName,' does not exist'].
  3107.     (aSymbol isKindOf: Class)
  3108.         ifTrue: [newObject _ aSymbol default]
  3109.         ifFalse: [(aSymbol isKindOf: ThreeDObject)
  3110.             ifTrue: [newObject _ aSymbol]
  3111.             ifFalse: [^self error: aName,' is not a Three-D Object']].
  3112.     newPoint _ self view currentTransformation applyInverseTo:
  3113.             ((self view inverseDisplayTransform:
  3114.                 (self view insetDisplayBox center)) asThreeDPoint).
  3115.      newObject moveObject: newObject refPoint to: newPoint.
  3116.     self model addObject: newObject.
  3117.     self model changed!
  3118.  
  3119. addPlane
  3120.     "Set the current red button operation to be add plane."
  3121.  
  3122.     redButtonFunction _ #addPlane!
  3123.  
  3124. moveObject
  3125.     "Set the current red button operation to be move object."
  3126.  
  3127.     redButtonFunction _ #moveObject!
  3128.  
  3129. moveVertex
  3130.     "Set the current red button operation to be move vertex."
  3131.  
  3132.     redButtonFunction _ #moveVertex!
  3133.  
  3134. removeObject
  3135.     "Set the current red button operation to be remove object."
  3136.  
  3137.     redButtonFunction _ #removeObject! !
  3138.  
  3139. !ThreeDController methodsFor: 'control defaults'!
  3140.  
  3141. isControlActive
  3142.  
  3143.     ^(view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! !
  3144.  
  3145. !ThreeDController methodsFor: 'button activities'!
  3146.  
  3147. action: aSymbol at: aPoint
  3148.     "Perform the action indicated by aSymbol at aPoint."
  3149.  
  3150.     aSymbol == #moveVertex ifTrue: [^self moveVertexAt: aPoint].
  3151.     aSymbol == #moveObject ifTrue: [^self moveObjectAt: aPoint].
  3152.     aSymbol == #removeObject ifTrue: [^self removeObjectAt: aPoint].
  3153.     aSymbol == #addLine ifTrue: [^self addLineAt: aPoint].
  3154.     aSymbol == #addPlane ifTrue: [^self addPlaneAt: aPoint].!
  3155.  
  3156. addLineAt: aPoint
  3157.     "Add a ThreeDLine to the model starting at aPoint."
  3158.  
  3159.     | startPoint oldCursorPoint newCursorPoint newLine |
  3160.     startPoint _ (self view inverseDisplayTransform: aPoint) asThreeDPoint.
  3161.     oldCursorPoint _ aPoint.
  3162.     newLine _ ThreeDLine start: startPoint end: startPoint.
  3163.     self view displayLine: newLine.
  3164.     [sensor redButtonPressed] whileTrue: [
  3165.         newCursorPoint _ sensor cursorPoint.
  3166.         newCursorPoint = oldCursorPoint ifFalse: [
  3167.             self view displayLine: newLine.
  3168.             newLine end: (self view inverseDisplayTransform: newCursorPoint) asThreeDPoint.
  3169.             self view displayLine: newLine.
  3170.             oldCursorPoint _ newCursorPoint]].
  3171.     (newLine start = newLine end) ifFalse: [
  3172.         self model addObject:
  3173.             (self view currentTransformation applyInverseTo: newLine)]!
  3174.  
  3175. addPlaneAt: aPoint
  3176.     "Add a ThreeDPlane to the model starting at aPoint."
  3177.  
  3178.     | points endPoint oldCursorPoint newCursorPoint |
  3179.     endPoint _ (self view inverseDisplayTransform: aPoint) asThreeDPoint.
  3180.     points _ OrderedCollection with: endPoint.
  3181.     oldCursorPoint _ aPoint.
  3182.     self displayPolygon: points with: endPoint.
  3183.     [sensor yellowButtonPressed] whileFalse: [
  3184.         (sensor redButtonPressed)
  3185.           ifTrue: [
  3186.             newCursorPoint _ sensor cursorPoint.
  3187.             newCursorPoint = oldCursorPoint ifFalse: [
  3188.                 self displayPolygon: points with: endPoint.
  3189.                 endPoint _ (self view inverseDisplayTransform: newCursorPoint) asThreeDPoint.
  3190.                 self displayPolygon: points with: endPoint.
  3191.                 oldCursorPoint _ newCursorPoint]]
  3192.           ifFalse: [
  3193.             points addLast: endPoint.
  3194.             [sensor redButtonPressed or:
  3195.                     [sensor yellowButtonPressed]] whileFalse.
  3196.             (points size = 2) ifTrue: [
  3197.                 self view displayFrom: points first to: points last]]].
  3198.     self model addObject: (ThreeDPlane vertices:
  3199.         (points collect: [:eachPoint |
  3200.             self view currentTransformation applyInverseTo: eachPoint])).
  3201.     self model changed.
  3202.     [sensor yellowButtonPressed] whileTrue.!
  3203.  
  3204. moveObjectAt: aPoint
  3205.     "Identify the nearest vertex to aPoint.  Move the entire object
  3206.      with the cursor point."
  3207.  
  3208.     | vertex oldCursorPoint newCursorPoint newPoint |
  3209.     vertex _ self view findNearestVertexTo: aPoint.
  3210.     oldCursorPoint _ aPoint.
  3211.     vertex notNil ifTrue: [[sensor redButtonPressed] whileTrue: [
  3212.         newCursorPoint _ sensor cursorPoint.
  3213.         newCursorPoint = oldCursorPoint ifFalse: [
  3214.             newPoint _ (self view inverseDisplayTransform: newCursorPoint)
  3215.                             asThreeDPoint.
  3216.             newPoint z: (self view currentTransformation applyTo: vertex) z.
  3217.             self model
  3218.                 moveObject: vertex
  3219.                 to: (self view currentTransformation applyInverseTo: newPoint).
  3220.             oldCursorPoint _ newCursorPoint]]]!
  3221.  
  3222. moveVertexAt: aPoint
  3223.     "Identify the nearest vertex to aPoint.  Move the identified vertex
  3224.      with the cursor point."
  3225.  
  3226.     | vertex oldCursorPoint newCursorPoint newPoint |
  3227.     vertex _ self view findNearestVertexTo: aPoint.
  3228.     oldCursorPoint _ aPoint.
  3229.     vertex notNil ifTrue: [[sensor redButtonPressed] whileTrue: [
  3230.         newCursorPoint _ sensor cursorPoint.
  3231.         newCursorPoint = oldCursorPoint ifFalse: [
  3232.             newPoint _ (self view inverseDisplayTransform: newCursorPoint)
  3233.                                      asThreeDPoint.
  3234.             newPoint z: (self view currentTransformation applyTo: vertex) z.
  3235.             self model
  3236.                 moveVertex: vertex
  3237.                 to: (self view currentTransformation applyInverseTo: newPoint).
  3238.             oldCursorPoint _ newCursorPoint]]]!
  3239.  
  3240. redButtonActivity
  3241.     "Perform the current red button activity at the current input point."
  3242.  
  3243.     sensor redButtonPressed ifTrue: [
  3244.         self action: redButtonFunction at: sensor cursorPoint]!
  3245.  
  3246. removeObjectAt: aPoint
  3247.     "Identify the nearest vertex to aPoint.  Remove the entire object
  3248.      pointed to."
  3249.  
  3250.     | vertex |
  3251.     vertex _ self view findNearestVertexTo: aPoint.
  3252.     vertex notNil ifTrue: [self model removeObject: vertex]! !
  3253.  
  3254. !ThreeDController methodsFor: 'private'!
  3255.  
  3256. displayPolygon: aCollection with: aThreeDPoint
  3257.     "Display the polygon represented by aCollection of
  3258.      ThreeDPoints together with aThreeDPoint."
  3259.  
  3260.     (aCollection size = 1)
  3261.         ifTrue: [self view displayFrom: aCollection first to: aThreeDPoint]
  3262.         ifFalse: [
  3263.             self view displayFrom: aCollection first to: aThreeDPoint.
  3264.             self view displayFrom: aCollection last to: aThreeDPoint].! !
  3265. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3266.  
  3267. ThreeDController class
  3268.     instanceVariableNames: ''!
  3269.  
  3270.  
  3271. !ThreeDController class methodsFor: 'class initialization'!
  3272.  
  3273. initialize
  3274.     "Initialize the yellow button menu."
  3275.  
  3276.     ThreeDYellowButtonMenu _ PopUpMenu
  3277.         labels: 'move vertex\move object\remove object\add object\add line\add plane' withCRs
  3278.         lines: #(3 4).
  3279.  
  3280.     ThreeDYellowButtonMessages _ #(moveVertex moveObject removeObject addObject addLine addPlane).
  3281.  
  3282.     "ThreeDController initialize."! !
  3283.  
  3284. ThreeDController initialize!
  3285.  
  3286.  
  3287. View subclass: #ThreeDView
  3288.     instanceVariableNames: 'writePen currentTransformation angleStep scaleStep translationStep transformedVertices '
  3289.     classVariableNames: 'DefaultAngleStep DefaultScaleStep DefaultTransformation DefaultTranslationStep DefaultWritePen '
  3290.     poolDictionaries: ''
  3291.     category: 'Three-D-Views'!
  3292.  
  3293.  
  3294. !ThreeDView methodsFor: 'initialize-release'!
  3295.  
  3296. initialize
  3297.     "Initialize the instance variables"
  3298.  
  3299.     super initialize.
  3300.     writePen _ DefaultWritePen.
  3301.     currentTransformation _ DefaultTransformation copy.
  3302.     angleStep _ DefaultAngleStep.
  3303.     scaleStep _ DefaultScaleStep.
  3304.     translationStep _ DefaultTranslationStep! !
  3305.  
  3306. !ThreeDView methodsFor: 'accessing'!
  3307.  
  3308. angleStep
  3309.     "Answer with the current value of the step used when rotating."
  3310.  
  3311.     ^angleStep!
  3312.  
  3313. angleStep: aNumber
  3314.     "Set the current value of the step used when rotating."
  3315.  
  3316.     angleStep _ aNumber!
  3317.  
  3318. currentTransformation
  3319.     "Answer with the current ThreeDTransformation."
  3320.  
  3321.     ^currentTransformation!
  3322.  
  3323. findNearestVertexTo: aPoint
  3324.     "Find the nearest vertex in the model to aPoint (which is in
  3325.      absolute coordinates).  Answer nil if no vertex is close enough,
  3326.      otherwise answer with the selected vertex."
  3327.  
  3328.     | vertices displayPoint nearby |
  3329.     vertices _ self displayedVertices.
  3330.     displayPoint _ self inverseDisplayTransform: aPoint.
  3331.     nearby _ vertices select: [:each |
  3332.         (each asPoint dist: displayPoint) < 20].
  3333.     nearby size = 0 ifTrue: [^nil].
  3334.     ^self model findVertexNear: (currentTransformation applyInverseTo:
  3335.         (nearby asSortedCollection: [:first :second |
  3336.             (first asPoint dist: displayPoint) < (second asPoint dist: displayPoint)]) first)!
  3337.  
  3338. scaleStep
  3339.     "Answer with the current value of the step used when scaling."
  3340.  
  3341.     ^scaleStep!
  3342.  
  3343. scaleStep: aNumber
  3344.     "Set the current value of the step used when scaling."
  3345.  
  3346.     scaleStep _ aNumber!
  3347.  
  3348. translationStep
  3349.     "Answer with the current value of the step used when translating."
  3350.  
  3351.     ^translationStep!
  3352.  
  3353. translationStep: aNumber
  3354.     "Set the current value of the step used when translating."
  3355.  
  3356.     translationStep _ aNumber! !
  3357.  
  3358. !ThreeDView methodsFor: 'defaults accessing'!
  3359.  
  3360. defaultAngle
  3361.     "Answer with the default angle of view."
  3362.  
  3363.     ^DefaultTransformation rotation deepCopy!
  3364.  
  3365. defaultAngleStep
  3366.     "Answer with the default angle step."
  3367.  
  3368.     ^DefaultAngleStep!
  3369.  
  3370. defaultScale
  3371.     "Answer with the default scale."
  3372.  
  3373.     ^DefaultTransformation scale deepCopy!
  3374.  
  3375. defaultScaleStep
  3376.     "Answer with the default scale step."
  3377.  
  3378.     ^DefaultScaleStep!
  3379.  
  3380. defaultTranslation
  3381.     "Answer with the default translation."
  3382.  
  3383.     ^DefaultTransformation translation deepCopy!
  3384.  
  3385. defaultTranslationStep
  3386.     "Answer with the default translation step."
  3387.  
  3388.     ^DefaultTranslationStep! !
  3389.  
  3390. !ThreeDView methodsFor: 'button messages'!
  3391.  
  3392. fill
  3393.     "Fill the planes represented by the model, starting at the back."
  3394.  
  3395.     self depthSortFill: self displayedPlanes!
  3396.  
  3397. rotXneg
  3398.     "Rotate the view about the X-axis by a negative amount."
  3399.  
  3400.     currentTransformation _ currentTransformation rotateXBy: (0 - angleStep).
  3401.     self displayView!
  3402.  
  3403. rotXpos
  3404.     "Rotate the view about the X-axis by a positive amount."
  3405.  
  3406.     currentTransformation _ currentTransformation rotateXBy: angleStep.
  3407.     self displayView!
  3408.  
  3409. rotYneg
  3410.     "Rotate the view about the Y-axis by a negative amount."
  3411.  
  3412.     currentTransformation _ currentTransformation rotateYBy: (0 - angleStep).
  3413.     self displayView!
  3414.  
  3415. rotYpos
  3416.     "Rotate the view about the Y-axis by a positive amount."
  3417.  
  3418.     currentTransformation _ currentTransformation rotateYBy: angleStep.
  3419.     self displayView!
  3420.  
  3421. rotZneg
  3422.     "Rotate the view about the Z-axis by a negative amount."
  3423.  
  3424.     currentTransformation _ currentTransformation rotateZBy: (0 - angleStep).
  3425.     self displayView!
  3426.  
  3427. rotZpos
  3428.     "Rotate the view about the Z-axis by a positive amount."
  3429.  
  3430.     currentTransformation _ currentTransformation rotateZBy: angleStep.
  3431.     self displayView!
  3432.  
  3433. scaleLarger
  3434.     "Scale the view in all axes to make it larger."
  3435.  
  3436.     currentTransformation noScale ifFalse: [
  3437.          currentTransformation _ currentTransformation scaleBy: scaleStep].
  3438.     self displayView!
  3439.  
  3440. scaleSmaller
  3441.     "Scale the view in all axes to make it smaller."
  3442.  
  3443.     currentTransformation noScale ifFalse: [
  3444.          currentTransformation _ currentTransformation scaleBy: (1.0 / scaleStep)].
  3445.     self displayView!
  3446.  
  3447. setDefaultRotation
  3448.     "Display the view using the default value of rotation."
  3449.  
  3450.      currentTransformation _ ThreeDTransformation
  3451.                     scale: currentTransformation scale
  3452.                     translation: currentTransformation translation
  3453.                     rotation: self defaultAngle.
  3454.     self displayView!
  3455.  
  3456. setDefaultScale
  3457.     "Scale the view in all axes, using the default values."
  3458.  
  3459.     currentTransformation noScale ifFalse: [
  3460.          currentTransformation _ ThreeDTransformation
  3461.                     scale: self defaultScale
  3462.                     translation: currentTransformation translation
  3463.                     rotation: currentTransformation rotation].
  3464.     self displayView!
  3465.  
  3466. setDefaultTranslation
  3467.     "Display the view using the default value of translation."
  3468.  
  3469.      currentTransformation _ ThreeDTransformation
  3470.                     scale: currentTransformation scale
  3471.                     translation: self defaultTranslation
  3472.                     rotation: currentTransformation rotation.
  3473.     self displayView!
  3474.  
  3475. transXneg
  3476.     "Translate the view in the X-axis negatively."
  3477.  
  3478.     | temp |
  3479.     temp _ currentTransformation translation asThreeDPoint.
  3480.     currentTransformation translation: (temp x: temp x - translationStep).
  3481.     self displayView!
  3482.  
  3483. transXpos
  3484.     "Translate the view in the X-axis positively."
  3485.  
  3486.     | temp |
  3487.     temp _ currentTransformation translation asThreeDPoint.
  3488.     currentTransformation translation: (temp x: temp x + translationStep).
  3489.     self displayView!
  3490.  
  3491. transYneg
  3492.     "Translate the view in the Y-axis negatively."
  3493.  
  3494.     | temp |
  3495.     temp _ currentTransformation translation asThreeDPoint.
  3496.     currentTransformation translation: (temp y: temp y - translationStep).
  3497.     self displayView!
  3498.  
  3499. transYpos
  3500.     "Translate the view in the Y-axis positively."
  3501.  
  3502.     | temp |
  3503.     temp _ currentTransformation translation asThreeDPoint.
  3504.     currentTransformation translation: (temp y: temp y + translationStep).
  3505.     self displayView!
  3506.  
  3507. transZneg
  3508.     "Translate the view in the Z-axis negatively."
  3509.  
  3510.     | temp |
  3511.     temp _ currentTransformation translation asThreeDPoint.
  3512.     currentTransformation translation: (temp z: temp z - translationStep).
  3513.     self displayView!
  3514.  
  3515. transZpos
  3516.     "Translate the view in the Z-axis positively."
  3517.  
  3518.     | temp |
  3519.     temp _ currentTransformation translation asThreeDPoint.
  3520.     currentTransformation translation: (temp z: temp z + translationStep).
  3521.     self displayView! !
  3522.  
  3523. !ThreeDView methodsFor: 'displaying'!
  3524.  
  3525. displayEdges: region
  3526.     "Display the edges represented by region (an Array of Points)."
  3527.  
  3528.     self
  3529.         displayEdges: region
  3530.         on: Display
  3531.         offset: 0@0
  3532.         clippingBox: self insetDisplayBox!
  3533.  
  3534. displayEdges: region on: aDisplayMedium
  3535.     "Display the edges represented by region (an Array of Points)."
  3536.  
  3537.     self displayEdges: region on: aDisplayMedium offset: 0@0!
  3538.  
  3539. displayEdges: region on: aDisplayMedium offset: aPoint 
  3540.     "Display the edges represented by region (an Array of Points)."
  3541.  
  3542.     self
  3543.         displayEdges: region
  3544.         on: aDisplayMedium
  3545.         offset: aPoint
  3546.         clippingBox: aDisplayMedium boundingBox!
  3547.  
  3548. displayEdges: region on: aDisplayMedium offset: aPoint clippingBox: aRectangle
  3549.     "Display the edges represented by region (an Array of Points)."
  3550.  
  3551.     | pen |
  3552.     pen _ Pen new destForm: aDisplayMedium.
  3553.     pen frame: aRectangle.
  3554.     1 to: (region size - 1) do: [:i |
  3555.         pen place: (region at: i) - aPoint.
  3556.         pen goto: (region at: i + 1) - aPoint].
  3557.     pen place: (region last) - aPoint.
  3558.     pen goto: (region first) - aPoint!
  3559.  
  3560. displayFrom: start to: end
  3561.     "Display, using reverse mode, a line from start to end
  3562.      (which are both ThreeDPoints)."
  3563.  
  3564.     | pen |
  3565.     pen _ Pen new frame: self insetDisplayBox.
  3566.     pen combinationRule: Form reverse.
  3567.     pen destForm: Display.
  3568.     pen place: (self transformForDisplay: start).
  3569.     pen goto: (self transformForDisplay: end)!
  3570.  
  3571. displayLine: aThreeDLine
  3572.     "Display, using reverse mode, aThreeDLine."
  3573.  
  3574.     | pen |
  3575.     pen _ Pen new frame: self insetDisplayBox.
  3576.     pen combinationRule: Form reverse.
  3577.     pen destForm: Display.
  3578.     pen place: (self transformForDisplay: aThreeDLine start).
  3579.     pen goto: (self transformForDisplay: aThreeDLine end)!
  3580.  
  3581. displayLines: lines
  3582.     "Display the lines (an OrderedCollection)."
  3583.  
  3584.     | start end |
  3585.     writePen frame: self insetDisplayBox.
  3586.     lines do: [:each |
  3587.         start _ self transformForDisplay: each start.
  3588.         end _ self transformForDisplay: each end.
  3589.         (self preClipFrom: start to: end) ifFalse: [
  3590.             writePen place: start.
  3591.             writePen goto: end]]!
  3592.  
  3593. displayPlane: aThreeDPlane
  3594.     "Display aThreeDPlane on the view."
  3595.  
  3596.     | size region form opaqueForm |
  3597.     size _ aThreeDPlane vertices size.
  3598.     (size < 2) ifTrue: [^self].
  3599.     region _ (aThreeDPlane vertices collect: [:eachVertex |
  3600.         self transformForDisplay: eachVertex]) asArray.
  3601.      (size = 2) ifTrue: [^self displayEdges: region].
  3602.     form _ Form fromRectangle: (self insetDisplayBox expandBy: 100).
  3603.     self displayEdges: region on: form offset: form offset clippingBox: Display boundingBox.
  3604.     form convexShapeFill: Form black.
  3605.     opaqueForm _ OpaqueForm shape: form.
  3606.     opaqueForm
  3607.         displayOn: Display
  3608.         at: 0@0
  3609.         clippingBox: self insetDisplayBox
  3610.         rule: Form over
  3611.         mask: Form veryLightGray.
  3612.     self displayEdges: region.!
  3613.  
  3614. displayView
  3615.     "Remove the currently displayed lines.  Calculate the
  3616.      new lines according to currentTransformation
  3617.      (a ThreeDTransformation), and display them."
  3618.  
  3619.     | lines |
  3620.     lines _ self displayedLines.
  3621.     self clearInside.
  3622.     self displayLines: lines!
  3623.  
  3624. update: aParameter
  3625.     "Ignore aParameter, and update the display."
  3626.  
  3627.     self topView isCollapsed ifFalse: [
  3628.         self displaySafe: [self displayView]]! !
  3629.  
  3630. !ThreeDView methodsFor: 'filling'!
  3631.  
  3632. depthSortFill: planes
  3633.     "Depth-sort and fill the planes (an OrderedCollection)."
  3634.  
  3635.     | sortedPlanes eachPlane  |
  3636.     planes size = 0 ifTrue: [^self].
  3637.     sortedPlanes _ self sortPlanes: planes.
  3638.     sortedPlanes size timesRepeat: [
  3639.         eachPlane _ sortedPlanes removeFirst.
  3640.         (self displayPlane: eachPlane inFrontOf: sortedPlanes) ifFalse: [
  3641.             sortedPlanes addLast: eachPlane]].
  3642.     sortedPlanes do: [:each |
  3643.         self displayPlane: each].!
  3644.  
  3645. displayPlane: aPlane inFrontOf: otherPlanes
  3646.     "Display aPlane 'in front' of the planes in the OrderedCollection
  3647.      otherPlanes, if possible.  Answer true if aPlane was displayed,
  3648.      otherwise false."
  3649.  
  3650.     | zOverlaps xOverlaps yOverlaps c1 d1 c2 d2 |
  3651.     zOverlaps _ self overlappingZ: aPlane with: otherPlanes.
  3652.     zOverlaps size = 0 ifTrue: [self displayPlane: aPlane.  ^true].
  3653.     xOverlaps _ self overlappingX: aPlane with: zOverlaps.
  3654.     xOverlaps size = 0 ifTrue: [self displayPlane: aPlane.  ^true].
  3655.     yOverlaps _ self overlappingY: aPlane with: xOverlaps.
  3656.     yOverlaps size = 0 ifTrue: [self displayPlane: aPlane.  ^true].
  3657.     c1 _ yOverlaps select: [:eachPlane |
  3658.         d1 _ eachPlane vertices select: [:eachVertex |
  3659.             self dotProduct: aPlane with: eachVertex].
  3660.         d1 size = eachPlane vertices size].
  3661.     c1 size = yOverlaps size ifTrue: [self displayPlane: aPlane.  ^true].
  3662.     c2 _ yOverlaps select: [:eachPlane |
  3663.         d2 _ aPlane vertices select: [:eachVertex |
  3664.             self dotProduct: eachPlane with: eachVertex].
  3665.         d2 size = aPlane vertices size].
  3666.     c2 size = yOverlaps size ifTrue: [self displayPlane: aPlane.  ^true].
  3667.  
  3668.     ^false!
  3669.  
  3670. dotProduct: aPlane with: aPoint
  3671.     "Answer true if the dot products of every vertex in 
  3672.      aPlane with aPoint has the same sign, otherwise false."
  3673.  
  3674.     | count |
  3675.     count _ 0.
  3676.     aPlane vertices do: [:eachVertex |
  3677.         count _ count + (eachVertex dotProduct: aPoint) signPositive].
  3678.     ^(count abs = aPlane size)!
  3679.  
  3680. overlappingX: aThreeDPlane with: aCollection
  3681.     "Answer with a collection of ThreeDPlanes which overlap in
  3682.      the X direction with aThreeDPlane."
  3683.  
  3684.     | newCollection |
  3685.     newCollection _ aCollection select: [:eachPlane | eachPlane xOverlap: aThreeDPlane].
  3686.     ^newCollection!
  3687.  
  3688. overlappingY: aThreeDPlane with: aCollection
  3689.     "Answer with a collection of ThreeDPlanes which overlap in
  3690.      the Y direction with aThreeDPlane."
  3691.  
  3692.     | newCollection |
  3693.     newCollection _ aCollection select: [:eachPlane | eachPlane yOverlap: aThreeDPlane].
  3694.     ^newCollection!
  3695.  
  3696. overlappingZ: aThreeDPlane with: aCollection
  3697.     "Answer with a collection of ThreeDPlanes which overlap in
  3698.      the Z direction with aThreeDPlane."
  3699.  
  3700.     | newCollection |
  3701.     newCollection _ aCollection select: [:eachPlane | aThreeDPlane zOverlap: eachPlane].
  3702.     ^newCollection!
  3703.  
  3704. sortPlanes: planes
  3705.     "Answer with an OrderedCollection of ThreeDPlanes
  3706.      taken from planes which has been sorted in order
  3707.      of the furthest vertex."
  3708.  
  3709.     ^(planes asSortedCollection: [:first :second |
  3710.         first furthestVertex z > second furthestVertex z]) asOrderedCollection! !
  3711.  
  3712. !ThreeDView methodsFor: 'controller access'!
  3713.  
  3714. defaultControllerClass
  3715.  
  3716.     ^ThreeDController! !
  3717.  
  3718. !ThreeDView methodsFor: 'private'!
  3719.  
  3720. displayedLines
  3721.     "Answer with an OrderedCollection of transformed ThreeDLines
  3722.      representing the receiver's model."
  3723.  
  3724.     | vertices |
  3725.     vertices _ IdentityDictionary new.
  3726.     ^self model asLines collect: [:eachLine |
  3727.         ThreeDLine
  3728.             start: (vertices
  3729.                 at: (eachLine start)
  3730.                 addIfAbsent: [currentTransformation applyTo: eachLine start])
  3731.             end: (vertices
  3732.                 at: (eachLine end)
  3733.                 addIfAbsent: [currentTransformation applyTo: eachLine end])]!
  3734.  
  3735. displayedPlanes
  3736.     "Answer with an OrderedCollection of transformed ThreeDPlanes
  3737.      representing the receiver's model."
  3738.  
  3739.     ^self model asPlanes collect: [:each |
  3740.         currentTransformation applyTo: each]!
  3741.  
  3742. displayedVertices
  3743.     "Answer with an OrderedCollection of transformed ThreeDPoints
  3744.      representing the receiver's model."
  3745.  
  3746.     ^self model vertices collect: [:each |
  3747.         currentTransformation applyTo: each]!
  3748.  
  3749. preClipFrom: start to: end
  3750.     "Answer true if the line from start to end is completely to
  3751.      the left, right top or bottom of the display box, otherwise false."
  3752.  
  3753.     | left right top bottom |
  3754.     left _ self insetDisplayBox left.
  3755.     (start x <= left and: [end x <= left]) ifTrue: [^true].
  3756.     right _ self insetDisplayBox right.
  3757.     (start x >= right and: [end x >= right]) ifTrue: [^true].
  3758.     top _ self insetDisplayBox top.
  3759.     (start y <= top and: [end y <= top]) ifTrue: [^true].
  3760.     bottom _ self insetDisplayBox bottom.
  3761.     ^(start y >= bottom and: [end y >= bottom])!
  3762.  
  3763. transformForDisplay: aThreeDPoint
  3764.     "Answer with the Point in display coordinates corresponding
  3765.      to aThreeDPoint."
  3766.  
  3767.     ^(self displayTransformation applyTo: aThreeDPoint asPoint) rounded! !
  3768. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3769.  
  3770. ThreeDView class
  3771.     instanceVariableNames: ''!
  3772.  
  3773.  
  3774. !ThreeDView class methodsFor: 'instance creation'!
  3775.  
  3776. open
  3777.     "Create and schedule a new instance of me on the default
  3778.      ThreeDModel."
  3779.     "ThreeDView open."
  3780.  
  3781.     self openOn: ThreeDModel default!
  3782.  
  3783. openOn: aModel
  3784.     "Create and schedule a new instance of me on aModel."
  3785.     "ThreeDView openOn: (ThreeDModel with: Cone default)."
  3786.  
  3787.     | topView graphView buttonView scaleView vectorView fillView |
  3788.     topView _ StandardSystemView
  3789.                 model: nil
  3790.                 label: 'Three-D Graphics'
  3791.                 minimumSize: 390@546.
  3792.     topView borderWidth: 2.
  3793.     topView window: (-1@-1 corner: 101@141).
  3794.  
  3795.     graphView _ self new model: aModel.
  3796.     graphView borderWidth: 2.
  3797.     graphView insideColor: Form white.
  3798.     graphView window: (-100@-100 corner: 100@100).
  3799.  
  3800.     vectorView _ UnitVectorView new.
  3801.     topView addSubView: vectorView viewport: (79@119 corner: 100@140).
  3802.  
  3803.     buttonView _ ThreeDButtonView new model:
  3804.         (OrderedCollection with: graphView with: vectorView).
  3805.     topView addSubView: buttonView viewport: (0@101 corner: 65@140).
  3806.  
  3807.     scaleView _ ThreeDScaleView new model: graphView.
  3808.     topView addSubView: scaleView viewport: (66@101 corner: 100@118).
  3809.  
  3810.     fillView _ ThreeDFillView new model: graphView.
  3811.     topView addSubView: fillView viewport: (66@119 corner: 78@140).
  3812.  
  3813.     topView addSubView: graphView viewport: (0@0 corner: 100@100).
  3814.     topView controller open! !
  3815.  
  3816. !ThreeDView class methodsFor: 'class initialization'!
  3817.  
  3818. initialize
  3819.     "Initialize various default values."
  3820.     "ThreeDView initialize."
  3821.  
  3822.     DefaultWritePen _ Pen new.
  3823.     DefaultWritePen combinationRule: Form over.
  3824.     DefaultAngleStep _ 5.            "Eighteen steps to a quadrant."
  3825.     DefaultScaleStep _ 1.414.        "Step by square root 2."
  3826.     DefaultTranslationStep _ 10.
  3827.  
  3828.     DefaultTransformation _ ThreeDTransformation
  3829.         scale: 10.0
  3830.         translation: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  3831.         rotation: #(1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)! !
  3832.  
  3833. ThreeDView initialize!
  3834.  
  3835.  
  3836. View subclass: #ThreeDFillView
  3837.     instanceVariableNames: ''
  3838.     classVariableNames: ''
  3839.     poolDictionaries: ''
  3840.     category: 'Three-D-Views'!
  3841.  
  3842.  
  3843. !ThreeDFillView methodsFor: 'adding subviews'!
  3844.  
  3845. buildButtonViews
  3846.     "Add the button to the receiver."
  3847.  
  3848.     | button view |
  3849.     button _ Button newOff onAction: [self model perform: #fill].
  3850.     view _ SwitchView new model: button.
  3851.     view borderWidth: 2.
  3852.     view label: ('F' asText allBold asDisplayText).
  3853.     view controller: IndicatorOnSwitchController new.
  3854.     self addSubView: view viewport: (2@9 extent: 8@8).!
  3855.  
  3856. buildLabelViews
  3857.     "All the label to the receiver."
  3858.  
  3859.     | view |
  3860.     view _ DisplayTextView new model: 'Fill' asDisplayText.
  3861.     view controller: NoController new.
  3862.     view centered.
  3863.     view borderWidth: 2.
  3864.     view insideColor: Form white.
  3865.     self addSubView: view viewport: (1@1 extent: 10@6)!
  3866.  
  3867. buildSubViews
  3868.     "Add all the buttons and labels to the receiver."
  3869.  
  3870.     self buildButtonViews.
  3871.     self buildLabelViews! !
  3872. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3873.  
  3874. ThreeDFillView class
  3875.     instanceVariableNames: ''!
  3876.  
  3877.  
  3878. !ThreeDFillView class methodsFor: 'instance creation'!
  3879.  
  3880. new
  3881.     "Create a new instance of me."
  3882.  
  3883.     | view |
  3884.     view _ super new borderWidth: 2.
  3885.     view insideColor: Form darkGray.
  3886.     view window: (0@0 extent: 12@21).
  3887.     view buildSubViews.
  3888.     ^view! !
  3889.  
  3890. View subclass: #ThreeDButtonView
  3891.     instanceVariableNames: ''
  3892.     classVariableNames: 'DownArrow InArrow LeftArrow OutArrow RightArrow RLeftArrow RRightArrow UpArrow '
  3893.     poolDictionaries: ''
  3894.     category: 'Three-D-Views'!
  3895.  
  3896.  
  3897. !ThreeDButtonView methodsFor: 'adding subviews'!
  3898.  
  3899. buildButtonViews
  3900.     "Add all the buttons to the receiver."
  3901.  
  3902.     | offsets labels actions aButton aSwitchView |
  3903.     offsets _ OrderedCollection new.
  3904.     #(9 20 31) do: [:y |
  3905.         #(8 18 38 48) do: [:x | offsets addLast: x@y]].
  3906.     offsets _ offsets asArray.
  3907.  
  3908.     labels _ OrderedCollection new.
  3909.     labels add: DownArrow.  labels add: UpArrow.
  3910.     2 timesRepeat: [labels add: LeftArrow.  labels add: RightArrow].
  3911.     labels add: DownArrow.  labels add: UpArrow.
  3912.     labels add: RLeftArrow.  labels add: RRightArrow.
  3913.     labels add: InArrow.  labels add: OutArrow.
  3914.     labels _ labels asArray.
  3915.  
  3916.     actions _ #(
  3917.         rotXneg rotXpos transXneg transXpos
  3918.         rotYneg rotYpos transYpos transYneg
  3919.         rotZpos rotZneg transZpos transZneg).
  3920.  
  3921.     1 to: 12 do: [ :i |
  3922.         aButton _ Button newOff.
  3923.         aButton onAction: [self model do: [:each | each perform: (actions at: i)]].
  3924.         aSwitchView _ SwitchView new model: aButton.
  3925.         aSwitchView borderWidth: 2.
  3926.         aSwitchView label: (labels at: i).
  3927.         aSwitchView controller: RepeatSwitchController new.
  3928.         self
  3929.             addSubView: aSwitchView
  3930.             viewport: ((offsets at: i) extent: 8@8)]!
  3931.  
  3932. buildLabelViews
  3933.     "Add all the labels to the receiver."
  3934.  
  3935.     | xView yView zView tView rView |
  3936.     xView _ DisplayTextView new model: 'X' asDisplayText.
  3937.     xView controller: NoController new.
  3938.     xView centered.
  3939.     xView borderWidth: 2.
  3940.     xView insideColor: Form white.
  3941.     self addSubView: xView viewport: (29@10 extent: 6@6).
  3942.  
  3943.     yView _ DisplayTextView new model: 'Y' asDisplayText.
  3944.     yView controller: NoController new.
  3945.     yView centered.
  3946.     yView borderWidth: 2.
  3947.     yView insideColor: Form white.
  3948.     self addSubView: yView viewport: (29@21 extent: 6@6).
  3949.  
  3950.     zView _ DisplayTextView new model: 'Z' asDisplayText.
  3951.     zView controller: NoController new.
  3952.     zView centered.
  3953.     zView borderWidth: 2.
  3954.     zView insideColor: Form white.
  3955.     self addSubView: zView viewport: (29@32 extent: 6@6).
  3956.  
  3957.     rView _ DisplayTextView new model: 'Rotate' asDisplayText.
  3958.     rView controller: NoController new.
  3959.     rView centered.
  3960.     rView borderWidth: 2.
  3961.     rView insideColor: Form white.
  3962.     self addSubView: rView viewport: (8@1 extent: 18@6).
  3963.  
  3964.     tView _ DisplayTextView new model: 'Translate' asDisplayText.
  3965.     tView controller: NoController new.
  3966.     tView centered.
  3967.     tView borderWidth: 2.
  3968.     tView insideColor: Form white.
  3969.     self addSubView: tView viewport: (38@1 extent: 18@6).!
  3970.  
  3971. buildSubViews
  3972.     "Add all the buttons and labels to the receiver."
  3973.  
  3974.     self buildButtonViews.
  3975.     self buildLabelViews! !
  3976.  
  3977. !ThreeDButtonView methodsFor: 'controller access'!
  3978.  
  3979. defaultControllerClass
  3980.  
  3981.     ^ThreeDButtonController! !
  3982. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  3983.  
  3984. ThreeDButtonView class
  3985.     instanceVariableNames: ''!
  3986.  
  3987.  
  3988. !ThreeDButtonView class methodsFor: 'instance creation'!
  3989.  
  3990. new
  3991.     "Create a new instance of me."
  3992.  
  3993.     | view |
  3994.     view _ super new borderWidth: 2.
  3995.     view insideColor: Form darkGray.
  3996.     view window: (0@0 extent: 65@40).
  3997.     view buildSubViews.
  3998.     ^view! !
  3999.  
  4000. !ThreeDButtonView class methodsFor: 'class initialization'!
  4001.  
  4002. initialize
  4003.     "ThreeDButtonView initialize."
  4004.  
  4005.     LeftArrow _ Form
  4006.     extent: 32@32
  4007.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 1 0 3 0 7 0 15 0 31 0 63 65504 127 65504 255 65504 511 65504 1023 65504 1023 65504 511 65504 255 65504 127 65504 63 0 31 0 15 0 7 0 3 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0)
  4008.     offset: 0@0.
  4009.  
  4010.     RightArrow _ Form
  4011.     extent: 32@32
  4012.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 32768 0 49152 0 57344 0 61440 0 63488 1023 64512 1023 65024 1023 65280 1023 65408 1023 65472 1023 65472 1023 65408 1023 65280 1023 65024 0 64512 0 63488 0 61440 0 57344 0 49152 0 32768 0 0 0 0 0 0 0 0 0 0 0 0)
  4013.     offset: 0@0.
  4014.  
  4015.     UpArrow _ Form
  4016.     extent: 32@32
  4017.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 1 32768 3 49152 7 57344 15 61440 31 63488 63 64512 127 65024 255 65280 511 65408 1023 65472 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 15 63488 0 0 0 0 0 0 0 0 0 0)
  4018.     offset: 0@0.
  4019.  
  4020.     DownArrow _ Form
  4021.     extent: 32@32
  4022.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 31 61440 1023 65472 511 65408 255 65280 127 65024 63 64512 31 63488 15 61440 7 57344 3 49152 1 32768 0 0 0 0 0 0 0 0 0 0 0 0)
  4023.     offset: 0@0.
  4024.  
  4025.     InArrow _ Form
  4026.     extent: 32@32
  4027.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 49152 3 49152 3 49152 3 49152 2 16384 2 16384 2 16384 511 65408 483 51072 483 51072 511 65408 2 16384 2 16384 2 16384 3 49152 3 49152 3 49152 3 49152 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
  4028.     offset: 0@0.
  4029.  
  4030.     OutArrow _ Form
  4031.     extent: 32@32
  4032.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 49152 7 57344 15 61440 15 61440 15 61440 15 61440 7 57344 3 49152 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
  4033.     offset: 0@0.
  4034.  
  4035.     RLeftArrow _ Form
  4036.     extent: 32@32
  4037.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 128 0 448 0 992 0 1984 0 3968 0 7936 0 15872 0 31744 0 63488 1 61440 3 57344 1031 49152 1551 32768 1823 0 1982 0 2044 0 2040 0 2032 0 2040 0 2044 0 2046 0 2047 0 0 0 0 0 0 0 0 0 0 0)
  4038.     offset: 0@0.
  4039.  
  4040.     RRightArrow _ Form
  4041.     extent: 32@32
  4042.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 256 0 896 0 1984 0 992 0 496 0 248 0 124 0 62 0 31 0 15 32768 7 49152 3 57376 1 61536 0 63712 0 32224 0 16352 0 8160 0 4064 0 8160 0 16352 0 32736 0 65504 0 0 0 0 0 0 0 0 0 0)
  4043.     offset: 0@0.! !
  4044.  
  4045. ThreeDButtonView initialize!
  4046.  
  4047.  
  4048. MouseMenuController subclass: #ThreeDButtonController
  4049.     instanceVariableNames: ''
  4050.     classVariableNames: 'ButtonsYellowButtonMenu ButtonsYellowButtonMessages '
  4051.     poolDictionaries: ''
  4052.     category: 'Three-D-Views'!
  4053.  
  4054.  
  4055. !ThreeDButtonController methodsFor: 'initialize-release'!
  4056.  
  4057. initialize
  4058.     "Initialize the yellow button menus."
  4059.  
  4060.     super initialize.
  4061.     self
  4062.         yellowButtonMenu: ButtonsYellowButtonMenu
  4063.         yellowButtonMessages: ButtonsYellowButtonMessages! !
  4064.  
  4065. !ThreeDButtonController methodsFor: 'menu messages'!
  4066.  
  4067. defaultRotation
  4068.     "Reset the rotation to the default value."
  4069.  
  4070.     self model do: [:eachView | eachView setDefaultRotation]!
  4071.  
  4072. defaultRotationStep
  4073.     "Reset the rotation step factor to the default value."
  4074.  
  4075.     self model do: [:eachView | eachView angleStep: eachView defaultAngleStep]!
  4076.  
  4077. defaultTranslation
  4078.     "Reset the translation to the default value."
  4079.  
  4080.     self model do: [:eachView | eachView setDefaultTranslation]!
  4081.  
  4082. defaultTranslationStep
  4083.     "Reset the translation step factor to the default value."
  4084.  
  4085.     self model do: [:eachView |
  4086.         eachView translationStep: eachView defaultTranslationStep]!
  4087.  
  4088. rotateStep
  4089.     "Prompt the user for a new value for the rotation step.  Inform
  4090.      the model of the step value."
  4091.  
  4092.     | answer newStep |
  4093.     answer _ FillInTheBlank request: ' New Rotation Step (degrees)? '
  4094.                              initialAnswer: self model first angleStep printString.
  4095.     answer isEmpty ifFalse: [
  4096.         newStep _ Number readFrom: (ReadStream on: answer).
  4097.         self model do: [:eachView | eachView angleStep: newStep]]!
  4098.  
  4099. translateStep
  4100.     "Prompt the user for a new value for the translation step.  Inform
  4101.      the model of the step value."
  4102.  
  4103.     | answer newStep |
  4104.     answer _ FillInTheBlank request: ' New Translation Step? '
  4105.                              initialAnswer: self model first translationStep printString.
  4106.     answer isEmpty ifFalse: [
  4107.         newStep _ Number readFrom: (ReadStream on: answer).
  4108.         self model do: [:eachView | eachView translationStep: newStep]]! !
  4109.  
  4110. !ThreeDButtonController methodsFor: 'control defaults'!
  4111.  
  4112. isControlActive
  4113.  
  4114.     ^(view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! !
  4115. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4116.  
  4117. ThreeDButtonController class
  4118.     instanceVariableNames: ''!
  4119.  
  4120.  
  4121. !ThreeDButtonController class methodsFor: 'class initialization'!
  4122.  
  4123. initialize
  4124.     "Initialize the yellow button menu."
  4125.  
  4126.     ButtonsYellowButtonMenu _ PopUpMenu
  4127.         labels:
  4128. 'set rotate step
  4129. default rotation
  4130. default rotation step
  4131. set translate step
  4132. default translation
  4133. default translation step' lines: #(1 3 4).
  4134.  
  4135.     ButtonsYellowButtonMessages _ #(rotateStep defaultRotation defaultRotationStep translateStep defaultTranslation defaultTranslationStep).
  4136.  
  4137.     "ThreeDButtonController initialize."! !
  4138.  
  4139. ThreeDButtonController initialize!
  4140.  
  4141.  
  4142. ThreeDView subclass: #UnitVectorView
  4143.     instanceVariableNames: ''
  4144.     classVariableNames: ''
  4145.     poolDictionaries: ''
  4146.     category: 'Three-D-Views'!
  4147.  
  4148.  
  4149. !UnitVectorView methodsFor: 'initialize-release'!
  4150.  
  4151. initialize
  4152.     "Initialize the instance variables"
  4153.  
  4154.     super initialize.
  4155.     currentTransformation _ ThreeDTransformation
  4156.         scale: nil
  4157.         translation: (ThreeDPoint x: 0.0 y: 0.0 z: 0.0)
  4158.         rotation: #(1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)! !
  4159.  
  4160. !UnitVectorView methodsFor: 'defaults accessing'!
  4161.  
  4162. defaultAngle
  4163.     "Answer with the default angle of view."
  4164.  
  4165.     ^#(1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0)!
  4166.  
  4167. defaultScale
  4168.     "Answer with the default scale."
  4169.  
  4170.     ^nil!
  4171.  
  4172. defaultTranslation
  4173.     "Answer with the default translation."
  4174.  
  4175.     ^ThreeDPoint x: 0.0 y: 0.0 z: 0.0! !
  4176.  
  4177. !UnitVectorView methodsFor: 'button messages'!
  4178.  
  4179. scaleLarger
  4180.     "Do nothing; the unit vector view should not be scaled."!
  4181.  
  4182. scaleSmaller
  4183.     "Do nothing; the unit vector view should not be scaled."!
  4184.  
  4185. transXneg
  4186.     "Do nothing; the unit vector view should not be translated."!
  4187.  
  4188. transXpos
  4189.     "Do nothing; the unit vector view should not be translated."!
  4190.  
  4191. transYneg
  4192.     "Do nothing; the unit vector view should not be translated."!
  4193.  
  4194. transYpos
  4195.     "Do nothing; the unit vector view should not be translated."!
  4196.  
  4197. transZneg
  4198.     "Do nothing; the unit vector view should not be translated."!
  4199.  
  4200. transZpos
  4201.     "Do nothing; the unit vector view should not be translated."! !
  4202.  
  4203. !UnitVectorView methodsFor: 'displaying'!
  4204.  
  4205. displayLine: aLine label: aString
  4206.     "Display the line aLine, labelled by aString."
  4207.  
  4208.     | end |
  4209.     end _ (self displayTransformation applyTo: aLine end asPoint) rounded.
  4210.     writePen place: (self displayTransformation applyTo: aLine start asPoint) rounded.
  4211.     writePen goto: end.
  4212.     aString asDisplayText
  4213.         displayOn: Display
  4214.         at: end
  4215.         clippingBox: self insetDisplayBox
  4216.         rule: Form under
  4217.         mask: Form black!
  4218.  
  4219. displayView
  4220.     "Calculate the new lines according to the
  4221.      currentTransformation and display them."
  4222.  
  4223.     writePen frame: self insetDisplayBox.
  4224.     self clearInside.
  4225.     self displayLine: (currentTransformation applyTo: self model xLine) label: 'X'.
  4226.     self displayLine: (currentTransformation applyTo: self model yLine) label: 'Y'.
  4227.     self displayLine: (currentTransformation applyTo: self model zLine) label: 'Z'! !
  4228.  
  4229. !UnitVectorView methodsFor: 'controller access'!
  4230.  
  4231. defaultControllerClass
  4232.  
  4233.     ^NoController! !
  4234. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4235.  
  4236. UnitVectorView class
  4237.     instanceVariableNames: ''!
  4238.  
  4239.  
  4240. !UnitVectorView class methodsFor: 'instance creation'!
  4241.  
  4242. new
  4243.     "Create a new instance of me."
  4244.  
  4245.     | view |
  4246.     view _ super new model: UnitVector new.
  4247.     view borderWidth: 2.
  4248.     view insideColor: Form white.
  4249.     view window: (-1.4@-1.4 corner: 1.4@1.4).
  4250.     ^view! !
  4251.  
  4252. View subclass: #ThreeDScaleView
  4253.     instanceVariableNames: ''
  4254.     classVariableNames: 'BiggerArrow SmallerArrow '
  4255.     poolDictionaries: ''
  4256.     category: 'Three-D-Views'!
  4257.  
  4258.  
  4259. !ThreeDScaleView methodsFor: 'adding subviews'!
  4260.  
  4261. buildButtonViews
  4262.     "Add all the buttons to the receiver."
  4263.  
  4264.     | leftButton rightButton leftView rightView |
  4265.     leftButton _ Button newOff onAction: [self model perform: #scaleSmaller].
  4266.     leftView _ SwitchView new model: leftButton.
  4267.     leftView borderWidth: 2.
  4268.     leftView label: SmallerArrow.
  4269.     leftView controller: RepeatSwitchController new.
  4270.     self addSubView: leftView viewport: (7@9 extent: 8@8).
  4271.  
  4272.     rightButton _ Button newOff onAction: [self model perform: #scaleLarger].
  4273.     rightView _ SwitchView new model: rightButton.
  4274.     rightView borderWidth: 2.
  4275.     rightView label: BiggerArrow.
  4276.     rightView controller: RepeatSwitchController new.
  4277.     self addSubView: rightView viewport: (18@9 extent: 8@8).!
  4278.  
  4279. buildLabelViews
  4280.     "All the label to the receiver."
  4281.  
  4282.     | view |
  4283.     view _ DisplayTextView new model: 'Scale' asDisplayText.
  4284.     view controller: NoController new.
  4285.     view centered.
  4286.     view borderWidth: 2.
  4287.     view insideColor: Form white.
  4288.     self addSubView: view viewport: (7@1 extent: 19@6).!
  4289.  
  4290. buildSubViews
  4291.     "Add all the buttons and labels to the receiver."
  4292.  
  4293.     self buildButtonViews.
  4294.     self buildLabelViews! !
  4295.  
  4296. !ThreeDScaleView methodsFor: 'controller access'!
  4297.  
  4298. defaultControllerClass
  4299.  
  4300.     ^ThreeDScaleController! !
  4301. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4302.  
  4303. ThreeDScaleView class
  4304.     instanceVariableNames: ''!
  4305.  
  4306.  
  4307. !ThreeDScaleView class methodsFor: 'instance creation'!
  4308.  
  4309. new
  4310.     "Create a new instance of me."
  4311.  
  4312.     | view |
  4313.     view _ super new borderWidth: 2.
  4314.     view insideColor: Form darkGray.
  4315.     view window: (0@0 extent: 34@18).
  4316.     view buildSubViews.
  4317.     ^view! !
  4318.  
  4319. !ThreeDScaleView class methodsFor: 'class initialization'!
  4320.  
  4321. initialize
  4322.     "ThreeDScaleView initialize."
  4323.  
  4324.     BiggerArrow _ Form
  4325.     extent: 32@32
  4326.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 512 32768 1793 49152 896 57344 448 28672 224 14336 112 7168 56 3584 28 1792 14 896 7 448 3 32992 3 32992 7 448 14 896 28 1792 56 3584 112 7168 224 14336 448 28672 896 57344 1793 49152 512 32768 0 0 0 0 0 0 0 0 0 0)
  4327.     offset: 0@0.
  4328.  
  4329.     SmallerArrow _ Form
  4330.     extent: 32@32
  4331.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 1 64 3 32992 7 448 14 896 28 1792 56 3584 112 7168 224 14336 448 28672 896 57344 1793 49152 1793 49152 896 57344 448 28672 224 14336 112 7168 56 3584 28 1792 14 896 7 448 3 32992 1 64 0 0 0 0 0 0 0 0 0 0)
  4332.     offset: 0@0.! !
  4333.  
  4334. ThreeDScaleView initialize!
  4335.  
  4336.  
  4337. MouseMenuController subclass: #ThreeDScaleController
  4338.     instanceVariableNames: ''
  4339.     classVariableNames: 'ScaleYellowButtonMenu ScaleYellowButtonMessages '
  4340.     poolDictionaries: ''
  4341.     category: 'Three-D-Views'!
  4342.  
  4343.  
  4344. !ThreeDScaleController methodsFor: 'initialize-release'!
  4345.  
  4346. initialize
  4347.     "Initialize the yellow button menus."
  4348.  
  4349.     super initialize.
  4350.     self
  4351.         yellowButtonMenu: ScaleYellowButtonMenu
  4352.         yellowButtonMessages: ScaleYellowButtonMessages! !
  4353.  
  4354. !ThreeDScaleController methodsFor: 'menu messages'!
  4355.  
  4356. defaultScale
  4357.     "Reset the scaling step factor to the default value."
  4358.  
  4359.     self model setDefaultScale!
  4360.  
  4361. defaultStep
  4362.     "Reset the scaling step factor to the default value."
  4363.  
  4364.     self model scaleStep: self model defaultScaleStep!
  4365.  
  4366. scaleStep
  4367.     "Prompt the user for a new value for the scaling step.  Inform
  4368.      the model of the step value."
  4369.  
  4370.     | answer newStep |
  4371.     answer _ FillInTheBlank request: ' New Scale Step factor? '
  4372.                              initialAnswer: self model scaleStep printString.
  4373.     answer isEmpty ifFalse: [
  4374.         newStep _ Number readFrom: (ReadStream on: answer).
  4375.         self model scaleStep: newStep]! !
  4376.  
  4377. !ThreeDScaleController methodsFor: 'control defaults'!
  4378.  
  4379. isControlActive
  4380.  
  4381.     ^(view containsPoint: sensor cursorPoint) & sensor blueButtonPressed not! !
  4382. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  4383.  
  4384. ThreeDScaleController class
  4385.     instanceVariableNames: ''!
  4386.  
  4387.  
  4388. !ThreeDScaleController class methodsFor: 'class initialization'!
  4389.  
  4390. initialize
  4391.     "Initialize the yellow button menu."
  4392.  
  4393.     ScaleYellowButtonMenu _ PopUpMenu
  4394.         labels: 'new scale step\default scale\default scale step' withCRs
  4395.         lines: #(1).
  4396.  
  4397.     ScaleYellowButtonMessages _ #(scaleStep defaultScale defaultStep).
  4398.  
  4399.     "ThreeDScaleController initialize."! !
  4400.  
  4401. ThreeDScaleController initialize!
  4402.  
  4403.